steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into modern-harvey3

modern-harvey3
Doug Coleman 2019-10-06 13:23:35 -05:00
parent 4a86d45c17 840ecce776
commit ea8f29706a
11 changed files with 53 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.travis.yml
View File

@ -72,5 +72,5 @@ script:
- "./factor -e='USING: memory vocabs.hierarchy ; \"zealot\" load save'"
- './factor -run=zealot.cli-changed-vocabs'
- './factor -run=tools.test `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
- './factor -run=help.lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
- './factor -run=zealot.help-lint `./factor -run=zealot.cli-changed-vocabs | paste -s -d " " -`'
- "./factor -e='USING: modern.paths tools.test sequences system kernel math random ; core-vocabs os macosx? [ dup length 3 /i sample ] when [ test ] each'"

2
basis/furnace/redirection/redirection-docs.factor
View File

@ -50,7 +50,7 @@ $nl
} ;
ARTICLE: "furnace.redirection" "Furnace redirection support"
"The " { $vocab-link "furnace.redirection" } " vocabulary builds additional functionality on top of " { $vocab-link "http.server.redirection" } ", and integrates with various Furnace features such as " { $link "furnace.asides" } " and " { $link "furnace.conversations" } "."
"The " { $vocab-link "furnace.redirection" } " vocabulary builds additional functionality on top of " { $vocab-link "http.server.redirection" } ", and integrates with various Furnace features such as " { $vocab-link "furnace.asides" } " and " { $vocab-link "furnace.conversations" } "."
$nl
"A redirection response which takes asides and conversations into account:"
{ $subsections <redirect> }

6
basis/furnace/utilities/utilities-docs.factor
View File

@ -34,19 +34,19 @@ HELP: hidden-form-field
HELP: link-attr
{ $values { "tag" tag } { "responder" "a responder" } }
{ $contract "Modifies an XHTML " { $snippet "a" } " tag." }
{ $notes "This word is called by " { $link "html.templates.chloe.tags.form" } "." }
{ $notes "This word is called by " { $vocab-link "html.templates.chloe" } "." }
{ $examples "Conversation scope adds attributes to link tags." } ;
HELP: modify-form
{ $values { "responder" "a responder" } { "xml/f" "an XML chunk or f" } }
{ $contract "Emits hidden form fields using " { $link hidden-form-field } "." }
{ $notes "This word is called by " { $link "html.templates.chloe.tags.form" } "." }
{ $notes "This word is called by " { $vocab-link "html.templates.chloe" } "." }
{ $examples "Session management, conversation scope and asides use hidden form fields to pass state." } ;
HELP: modify-query
{ $values { "query" assoc } { "responder" "a responder" } { "query'" assoc } }
{ $contract "Modifies the query parameters of a URL destined to be displayed as a link." }
{ $notes "This word is called by " { $link "html.templates.chloe.tags.form" } "." }
{ $notes "This word is called by " { $vocab-link "html.templates.chloe" } "." }
{ $examples "Asides add query parameters to URLs." } ;
HELP: modify-redirect-query

16
core/fry/fry-docs.factor
View File

@ -19,7 +19,7 @@ HELP: fry
HELP: \'[
{ $syntax "'[ code... ]" }
{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }
{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link POSTPONE: _ } " and " { $link POSTPONE: @ } "." }
{ $examples "See " { $link "fry.examples" } "." } ;
HELP: >r/r>-in-fry-error
@ -30,26 +30,26 @@ ARTICLE: "fry.examples" "Examples of fried quotations"
$nl
"If a quotation does not contain any fry specifiers, then " { $link \ \'[ } " behaves just like " { $link \ \[ } ":"
{ $code "{ 10 20 30 } '[ . ] each" }
"Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
"Occurrences of " { $link POSTPONE: _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"
{ $code
"{ 10 20 30 } 5 '[ _ + ] map"
"{ 10 20 30 } 5 [ + ] curry map"
"{ 10 20 30 } [ 5 + ] map"
}
"Occurrences of " { $link _ } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"
"Occurrences of " { $link POSTPONE: _ } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"
{ $code
"{ 10 20 30 } 5 '[ 3 _ / ] map"
"{ 10 20 30 } 5 [ 3 ] swap [ / ] curry compose map"
"{ 10 20 30 } [ 3 5 / ] map"
}
"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet "_ call" } ". The following four lines are equivalent:"
"Occurrences of " { $link POSTPONE: @ } " are simply syntax sugar for " { $snippet "_ call" } ". The following four lines are equivalent:"
{ $code
"{ 10 20 30 } [ sq ] '[ @ . ] each"
"{ 10 20 30 } [ sq ] [ call . ] curry each"
"{ 10 20 30 } [ sq ] [ . ] compose each"
"{ 10 20 30 } [ sq . ] each"
}
"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:"
"The " { $link POSTPONE: _ } " and " { $link POSTPONE: @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:"
{ $code
"{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry compose compose map"
@ -83,15 +83,15 @@ $nl
{ $subsections \ \'[ }
"There are two types of fry specifiers; the first can hold a value, and the second “splices” a quotation, as if it were inserted without surrounding brackets:"
{ $subsections
_
@
POSTPONE: _
POSTPONE: @
}
"The holes are filled in with the top of stack going in the rightmost hole, the second item on the stack going in the second hole from the right, and so on."
{ $subsections
"fry.examples"
"fry.philosophy"
}
"Fry is implemented as a parsing word which reads a quotation and scans for occurrences of " { $link _ } " and " { $link @ } "; these words are not actually executed, and doing so raises an error (this can happen if they're accidentally used outside of a fry)."
"Fry is implemented as a parsing word which reads a quotation and scans for occurrences of " { $link POSTPONE: _ } " and " { $link POSTPONE: @ } "; these words are not actually executed, and doing so raises an error (this can happen if they're accidentally used outside of a fry)."
$nl
"Fried quotations can also be constructed without using a parsing word; this is useful when meta-programming:"
{ $subsections fry }

6
core/fry/fry.factor
View File

@ -14,7 +14,7 @@ GENERIC: fry ( quot -- quot' )
dup { load-local load-locals get-local drop-locals } intersect
[ >r/r>-in-fry-error ] unless-empty ;
PREDICATE: fry-specifier < word { _ @ } member-eq? ;
PREDICATE: fry-specifier < word { POSTPONE: _ POSTPONE: @ } member-eq? ;
GENERIC: count-inputs ( quot -- n )
@ -86,11 +86,11 @@ INSTANCE: fried-callable fried
[ >quotation 1quotation prefix ] if-empty ;
: mark-composes ( quot -- quot' )
[ dup \ @ = [ drop [ _ @ ] ] [ 1quotation ] if ] map concat ; inline
[ dup \ @ = [ drop [ POSTPONE: _ POSTPONE: @ ] ] [ 1quotation ] if ] map concat ; inline
: shallow-fry ( quot -- quot' )
check-fry mark-composes
{ _ } split convert-curries
{ POSTPONE: _ } split convert-curries
[ [ [ ] ] [ [ ] (make-curry) but-last ] if-zero ]
[ shallow-spread>quot swap [ [ ] (make-curry) compose ] unless-zero ] if-empty ;

4
core/sequences/generalizations/generalizations.factor
View File

@ -131,10 +131,10 @@ MACRO: nmap-reduce ( map-quot reduce-quot n -- quot )
(neach) all-integers? ; inline
MACRO: finish-nfind ( n -- quot )
[ 1 + ] keep dup dup dup '[
[ 1 + ] keep dup dup dup f <array> >quotation '[
_ npick
[ [ dup ] _ ndip _ nnth-unsafe ]
[ _ ndrop _ [ f ] times ]
[ _ ndrop @ ]
if
] ;

2
core/stack-checker/values/values.factor
View File

@ -122,7 +122,7 @@ M: f (literal) current-word get bad-macro-input ;
GENERIC: known>callable ( known -- quot )
: ?@ ( x -- y )
dup callable? [ drop _ ] unless ;
dup callable? [ drop \ _ ] unless ;
M: object known>callable drop \ _ ;

3
extra/alien/data/map/map.factor
View File

@ -85,7 +85,8 @@ MACRO: unpack-params ( ins -- quot )
[ c-type-count nip '[ _ firstn-unsafe ] ] map '[ _ spread ] ;
MACRO: pack-params ( outs -- quot )
[ ] [ c-type-count nip dup [ [ ndip _ ] dip set-firstn ] 3curry ] reduce
[ ] [ c-type-count nip dup
[ [ ndip POSTPONE: _ ] dip set-firstn ] 3curry ] reduce
fry [ call ] compose ;
:: [data-map] ( ins outs param-quot -- quot )

2
extra/talks/otug-talk/otug-talk.factor
View File

@ -59,7 +59,7 @@ CONSTANT: otug-slides
}
{ $slide "Constructing quotations"
{ $code ": remove-comments* ( lines string -- lines' )" " '[ _ head? ] reject ;" "" ": remove-comments ( lines -- lines' )" " \"#\" remove-comments* ;" }
{ { $link @ } " inserts a quotation" }
{ { $link POSTPONE: @ } " inserts a quotation" }
{ $code ": replicate ( n quot -- seq )" " '[ drop @ ] map ;" }
{ $code "10 [ 1 10 [a,b] random ] replicate ." }
}

1
extra/zealot/help-lint/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

30
extra/zealot/help-lint/help-lint.factor Normal file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2019 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs cache command-line help.lint io io.monitors kernel
namespaces prettyprint sequences system vocabs.hierarchy ;
IN: zealot.help-lint
! FIXME: help-lint sometimes lists monitors and event-streams as leaked.
! event-stream is macosx-only so hack it into a string
CONSTANT: ignored-resources {
"linux-monitor" "macosx-monitor" "malloc-ptr"
"epoll-mx" "server-port" "openssl-context"
"cache-assoc" "input-port" "fd" "output-port" "stdin"
"event-stream"
}
: filter-flaky-resources ( seq -- seq' )
[ drop unparse ignored-resources member? ] assoc-reject ;
! Allow testing without calling exit
: zealot-help-lint ( exit? -- )
command-line get [ load ] each
help-lint-all
lint-failures get filter-flaky-resources
[ nip assoc-empty? [ "==== FAILING LINT" print :lint-failures flush ] unless ]
[ swap [ 0 1 ? (exit) ] [ drop ] if ] 2bi ;
: zealot-help-lint-main ( -- )
t zealot-help-lint ;
MAIN: zealot-help-lint-main