more use of H{ } make.
John Benediktsson
parent
559b5bfa5b
commit
90d0951ada
|
|
@ -585,14 +585,14 @@ M: quotation '
|
|||
PRIVATE>
|
||||
|
||||
: make-image ( arch -- )
|
||||
[
|
||||
parser-quiet? off
|
||||
auto-use? off
|
||||
architecture set
|
||||
architecture associate H{
|
||||
{ parser-quiet? f }
|
||||
{ auto-use? f }
|
||||
} assoc-union! [
|
||||
"resource:/core/bootstrap/stage1.factor" run-file
|
||||
build-image
|
||||
write-image
|
||||
] with-scope ;
|
||||
] with-variables ;
|
||||
|
||||
: make-images ( -- )
|
||||
images [ make-image ] each ;
|
||||
|
|
|
|||
|
|
@ -102,7 +102,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
|
|||
[ prefix 1array ] dip prefix , ;
|
||||
|
||||
: ($navigation-table) ( element -- )
|
||||
help-path-style get table-style set [ $table ] with-scope ;
|
||||
help-path-style get table-style [ $table ] with-variable ;
|
||||
|
||||
: $navigation-table ( topic -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.pathnames io.files io.encodings.ascii
|
||||
io.encodings.binary io.encodings.utf8 assocs sequences
|
||||
splitting kernel namespaces fry memoize ;
|
||||
splitting kernel make fry memoize ;
|
||||
IN: mime.types
|
||||
|
||||
MEMO: mime-db ( -- seq )
|
||||
|
|
@ -18,8 +18,8 @@ MEMO: mime-db ( -- seq )
|
|||
|
||||
MEMO: mime-types ( -- assoc )
|
||||
[
|
||||
mime-db [ unclip '[ [ _ ] dip set ] each ] each
|
||||
] H{ } make-assoc
|
||||
mime-db [ unclip '[ [ _ ] dip ,, ] each ] each
|
||||
] H{ } make
|
||||
nonstandard-mime-types assoc-union ;
|
||||
|
||||
: mime-type ( filename -- mime-type )
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
USING: arrays generic kernel math models namespaces sequences assocs
|
||||
tools.test models.mapping accessors ;
|
||||
tools.test models.mapping accessors make ;
|
||||
IN: models.mapping.tests
|
||||
|
||||
! Test mapping
|
||||
[ ] [
|
||||
[
|
||||
1 <model> "one" set
|
||||
2 <model> "two" set
|
||||
] H{ } make-assoc
|
||||
1 <model> "one" ,,
|
||||
2 <model> "two" ,,
|
||||
] H{ } make
|
||||
<mapping> "m" set
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -19,25 +19,23 @@ SYMBOL: c-object-pointers?
|
|||
15 nesting-limit set-global
|
||||
100 length-limit set-global
|
||||
10 number-base set-global
|
||||
string-limit? on
|
||||
t string-limit? set-global
|
||||
|
||||
: with-short-limits ( quot -- )
|
||||
[
|
||||
1 line-limit set
|
||||
15 length-limit set
|
||||
2 nesting-limit set
|
||||
string-limit? on
|
||||
boa-tuples? on
|
||||
c-object-pointers? off
|
||||
call
|
||||
] with-scope ; inline
|
||||
H{
|
||||
{ line-limit 1 }
|
||||
{ length-limit 15 }
|
||||
{ nesting-limit 2 }
|
||||
{ string-limit? t }
|
||||
{ boa-tuples? t }
|
||||
{ c-object-pointers? f }
|
||||
} clone swap with-variables ; inline
|
||||
|
||||
: without-limits ( quot -- )
|
||||
[
|
||||
nesting-limit off
|
||||
length-limit off
|
||||
line-limit off
|
||||
string-limit? off
|
||||
c-object-pointers? off
|
||||
call
|
||||
] with-scope ; inline
|
||||
H{
|
||||
{ nesting-limit f }
|
||||
{ length-limit f }
|
||||
{ line-limit f }
|
||||
{ string-limit? f }
|
||||
{ c-object-pointers? f }
|
||||
} clone swap with-variables ; inline
|
||||
|
|
|
|||
|
|
@ -101,11 +101,10 @@ SYMBOL: ->
|
|||
[
|
||||
"Quotation: " write
|
||||
dup [ second ] [ third ] bi remove-breakpoints
|
||||
[
|
||||
3 nesting-limit set
|
||||
100 length-limit set
|
||||
pprint
|
||||
] with-scope
|
||||
H{
|
||||
{ nesting-limit 3 }
|
||||
{ length-limit 100 }
|
||||
} clone [ pprint ] with-variables
|
||||
] with-cell
|
||||
] with-row
|
||||
dup frame-word? [
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ M: base64 item>xml
|
|||
params <XML <methodResponse><-></methodResponse> XML> ;
|
||||
|
||||
: return-fault ( fault-code fault-string -- xml )
|
||||
[ "faultString" set "faultCode" set ] H{ } make-assoc item>xml
|
||||
[ "faultString" ,, "faultCode" ,, ] H{ } make item>xml
|
||||
<XML
|
||||
<methodResponse>
|
||||
<fault>
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces accessors xml.tokenize xml.data assocs
|
||||
xml.errors xml.char-classes combinators.short-circuit splitting
|
||||
fry xml.state sequences combinators ascii math ;
|
||||
fry xml.state sequences combinators ascii math make ;
|
||||
IN: xml.name
|
||||
|
||||
! XML namespace processing: ns = namespace
|
||||
|
|
@ -15,13 +15,13 @@ SYMBOL: ns-stack
|
|||
[
|
||||
[
|
||||
swap dup space>> "xmlns" =
|
||||
[ main>> set ]
|
||||
[ main>> ,, ]
|
||||
[
|
||||
T{ name f "" "xmlns" f } names-match?
|
||||
[ "" set ] [ drop ] if
|
||||
[ "" ,, ] [ drop ] if
|
||||
] if
|
||||
] assoc-each
|
||||
] { } make-assoc f like ;
|
||||
] { } make f like ;
|
||||
|
||||
: add-ns ( name -- )
|
||||
dup space>> dup ns-stack get assoc-stack
|
||||
|
|
|
|||
|
|
@ -76,9 +76,9 @@ TUPLE: material
|
|||
|
||||
: read-mtl ( file -- material-dictionary )
|
||||
[
|
||||
f current-material set
|
||||
H{ } clone material-dictionary set
|
||||
] H{ } make-assoc
|
||||
f current-material ,,
|
||||
H{ } clone material-dictionary ,,
|
||||
] H{ } make
|
||||
[
|
||||
ascii file-lines [ line>mtl ] each
|
||||
md
|
||||
|
|
@ -104,7 +104,7 @@ VERTEX-FORMAT: obj-vertex-format
|
|||
[ 1 - vt get nth ] bi* 2array flatten
|
||||
] }
|
||||
} case ;
|
||||
|
||||
|
||||
: quad>aos ( x -- y z )
|
||||
[ 3 head [ triangle>aos 1array ] map ]
|
||||
[ [ 2 swap nth ]
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ CONSTANT: maximum-translation-size 5120
|
|||
|
||||
: parameters>assoc ( text from to -- assoc )
|
||||
"|" glue [
|
||||
[ "q" set ] [ "langpair" set ] bi*
|
||||
"1.0" "v" set
|
||||
] { } make-assoc ;
|
||||
[ "q" ,, ] [ "langpair" ,, ] bi*
|
||||
"1.0" "v" ,,
|
||||
] { } make ;
|
||||
|
||||
: assoc>query-response ( assoc -- response )
|
||||
google-translate-url http-post nip ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors fry http.client io io.encodings.utf8 io.files
|
||||
kernel mason.common mason.config mason.email mason.twitter
|
||||
namespaces prettyprint sequences debugger continuations ;
|
||||
namespaces prettyprint sequences debugger continuations make ;
|
||||
IN: mason.notify
|
||||
|
||||
: status-notify? ( -- ? )
|
||||
|
|
@ -11,14 +11,14 @@ IN: mason.notify
|
|||
|
||||
: status-params ( report arg message -- assoc )
|
||||
[
|
||||
short-host-name "host-name" set
|
||||
target-cpu get "target-cpu" set
|
||||
target-os get "target-os" set
|
||||
status-secret get "secret" set
|
||||
[ "report" set ]
|
||||
[ "arg" set ]
|
||||
[ "message" set ] tri*
|
||||
] H{ } make-assoc ;
|
||||
short-host-name "host-name" ,,
|
||||
target-cpu get "target-cpu" ,,
|
||||
target-os get "target-os" ,,
|
||||
status-secret get "secret" ,,
|
||||
[ "report" ,, ]
|
||||
[ "arg" ,, ]
|
||||
[ "message" ,, ] tri*
|
||||
] H{ } make ;
|
||||
|
||||
: status-notify ( report arg message -- )
|
||||
status-notify? [
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ ERROR: cl-error err ;
|
|||
|
||||
: 2info ( handle1 handle2 name info_quot lift_quot -- value )
|
||||
[ 4dup 2info-data-size 2info-data-bytes ] dip call ; inline
|
||||
|
||||
|
||||
: info-bool ( handle name quot -- ? )
|
||||
[ uint deref CL_TRUE = ] info ; inline
|
||||
|
||||
|
|
@ -414,15 +414,16 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ;
|
|||
GENERIC: bind-kernel-arg ( kernel index data -- )
|
||||
M: cl-buffer bind-kernel-arg bind-kernel-arg-buffer ;
|
||||
M: byte-array bind-kernel-arg bind-kernel-arg-data ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: with-cl-state ( context/f device/f queue/f quot -- )
|
||||
[
|
||||
[
|
||||
[ cl-current-queue set ] when*
|
||||
[ cl-current-device set ] when*
|
||||
[ cl-current-context set ] when*
|
||||
] 3curry H{ } make-assoc
|
||||
[ cl-current-queue ,, ] when*
|
||||
[ cl-current-device ,, ] when*
|
||||
[ cl-current-context ,, ] when*
|
||||
] 3curry H{ } make
|
||||
] dip with-variable ; inline
|
||||
|
||||
: cl-platforms ( -- platforms )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2009, 2010 Joe Groff, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators hashtables http
|
||||
http.client json.reader kernel macros namespaces sequences
|
||||
http.client json.reader kernel macros make namespaces sequences
|
||||
io.sockets.secure fry oauth urls ;
|
||||
FROM: assocs => change-at ;
|
||||
IN: twitter
|
||||
|
|
@ -131,9 +131,9 @@ PRIVATE>
|
|||
|
||||
: update-post-data ( update -- assoc )
|
||||
[
|
||||
"status" set
|
||||
twitter-source get "source" set
|
||||
] H{ } make-assoc ;
|
||||
"status" ,,
|
||||
twitter-source get "source" ,,
|
||||
] H{ } make ;
|
||||
|
||||
: (tweet) ( string -- json )
|
||||
update-post-data "update" status-url
|
||||
|
|
|
|||
Loading…
Reference in New Issue