fix stack effects/formatting in contrib files

darcs
erg 2006-10-05 17:39:13 +00:00
parent cb2a7e9ac5
commit 90d8b67ff0
6 changed files with 15 additions and 16 deletions

View File

@ -25,25 +25,25 @@ USING: sequences kernel parser math namespaces io ;
: get-text ( string -- remainder chunk ) : get-text ( string -- remainder chunk )
"<%" over start dup -1 = [ "<%" over start dup -1 = [
drop "" swap drop "" swap
] [ ] [
2dup head >r tail r> 2dup head >r tail r>
] if ; ] if ;
: get-embedded ( "<%code%>blah" -- "blah" "code" ) : get-embedded ( string -- string code-string )
! regexps where art thou? ! regexps where art thou?
"%>" over 2 start* 2dup swap 2 -rot subseq >r 2 + tail r> ; "%>" over 2 start* 2dup swap 2 -rot subseq >r 2 + tail r> ;
: get-first-chunk ( string -- string ) : get-first-chunk ( string -- string )
dup "<%" head? [ dup "<%" head? [
get-embedded parse % get-embedded parse %
] [ ] [
get-text , \ write , get-text , \ write ,
] if ; ] if ;
: embedded>factor ( string -- ) : embedded>factor ( string -- )
dup length 0 > [ dup length 0 > [
get-first-chunk embedded>factor get-first-chunk embedded>factor
] [ drop ] if ; ] [ drop ] if ;
: parse-embedded ( string -- quot ) : parse-embedded ( string -- quot )

View File

@ -71,7 +71,7 @@ reset-callback-table
#! Tuple for holding data related to a callback. #! Tuple for holding data related to a callback.
TUPLE: item quot expire? request id time-added ; TUPLE: item quot expire? request id time-added ;
C: item ( quot data data-quot expire? id -- item ) C: item ( quot expire? request id -- item )
millis over set-item-time-added millis over set-item-time-added
[ set-item-id ] keep [ set-item-id ] keep
[ set-item-request ] keep [ set-item-request ] keep

View File

@ -55,7 +55,7 @@ SYMBOL: html
: write-html H{ { html t } } format ; : write-html H{ { html t } } format ;
: html-word ( name def -- ) : html-word ( name def -- word )
#! Define 'word creating' word to allow #! Define 'word creating' word to allow
#! dynamically creating words. #! dynamically creating words.
>r "html" create dup r> define-compound ; >r "html" create dup r> define-compound ;

View File

@ -104,20 +104,17 @@ SYMBOL: responders
] make-hash add-responder ; ] make-hash add-responder ;
: make-responder ( quot -- responder ) : make-responder ( quot -- responder )
#! quot has stack effect ( url -- )
[ [
( url -- )
[ [
drop "GET method not implemented" httpd-error drop "GET method not implemented" httpd-error
] "get" set ] "get" set
( url -- )
[ [
drop "POST method not implemented" httpd-error drop "POST method not implemented" httpd-error
] "post" set ] "post" set
( url -- )
[ [
drop "HEAD method not implemented" httpd-error drop "HEAD method not implemented" httpd-error
] "head" set ] "head" set
( url -- )
[ [
drop bad-request drop bad-request
] "bad" set ] "bad" set

View File

@ -1,6 +1,6 @@
IN: vim IN: vim
USING: definitions embedded io kernel parser prettyprint process USING: definitions embedded io kernel namespaces parser prettyprint process
sequences namespaces ; sequences ;
: vim-location ( file line -- ) : vim-location ( file line -- )
>r [ file-modified ] keep r> >r [ file-modified ] keep r>

View File

@ -67,7 +67,8 @@ M: xml-string-error error.
char "\n\r" member? [ 0 column set line ] [ column ] if char "\n\r" member? [ 0 column set line ] [ column ] if
inc ; inc ;
: skip-until ( quot -- | quot: char -- ? ) : skip-until ( quot -- )
#! quot: ( char -- ? )
more? [ more? [
char swap [ call ] keep swap [ drop ] [ char swap [ call ] keep swap [ drop ] [
incr-spot skip-until incr-spot skip-until
@ -152,7 +153,8 @@ M: xml-string-error error.
! -- Parsing tags ! -- Parsing tags
: in-range-seq? ( number { { min max } ... } -- ? ) : in-range-seq? ( number seq -- ? )
#! seq: { { min max } { min max }* }
[ first2 between? ] contains-with? ; [ first2 between? ] contains-with? ;
: name-start-char? ( ch -- ? ) : name-start-char? ( ch -- ? )