basis/extra: removing '[ @ ] in favor of _ for fried quotations.
							parent
							
								
									dcb06f3cbd
								
							
						
					
					
						commit
						b40ba26bac
					
				| 
						 | 
					@ -139,7 +139,7 @@ MACRO: map-reduce-outputs ( quot mapper reducer -- quot )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
MACRO: smart-reduce ( reduce-quots -- quot )
 | 
					MACRO: smart-reduce ( reduce-quots -- quot )
 | 
				
			||||||
    unzip [ [ ] like ] bi@ dup length dup '[
 | 
					    unzip [ [ ] like ] bi@ dup length dup '[
 | 
				
			||||||
        [ @ ] dip [ @ _ cleave-curry _ spread* ] each
 | 
					        _ dip [ @ _ cleave-curry _ spread* ] each
 | 
				
			||||||
    ] ;
 | 
					    ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
MACRO: smart-map-reduce ( map-reduce-quots -- quot )
 | 
					MACRO: smart-map-reduce ( map-reduce-quots -- quot )
 | 
				
			||||||
| 
						 | 
					@ -151,7 +151,7 @@ MACRO: smart-map-reduce ( map-reduce-quots -- quot )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
MACRO: smart-2reduce ( 2reduce-quots -- quot )
 | 
					MACRO: smart-2reduce ( 2reduce-quots -- quot )
 | 
				
			||||||
    unzip [ [ ] like ] bi@ dup length dup '[
 | 
					    unzip [ [ ] like ] bi@ dup length dup '[
 | 
				
			||||||
        [ @ ] 2dip
 | 
					        _ 2dip
 | 
				
			||||||
        [ @ _ [ cleave-curry ] [ cleave-curry ] bi _ spread* ] 2each
 | 
					        [ @ _ [ cleave-curry ] [ cleave-curry ] bi _ spread* ] 2each
 | 
				
			||||||
    ] ;
 | 
					    ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -70,7 +70,7 @@ M: ##horizontal-shl-vector-imm insn-available? rep>> %horizontal-shl-vector-imm-
 | 
				
			||||||
M: ##horizontal-shr-vector-imm insn-available? rep>> %horizontal-shr-vector-imm-reps member? ;
 | 
					M: ##horizontal-shr-vector-imm insn-available? rep>> %horizontal-shr-vector-imm-reps member? ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: [vector-op-checked] ( #dup quot -- quot )
 | 
					: [vector-op-checked] ( #dup quot -- quot )
 | 
				
			||||||
    '[ _ ndup [ @ ] { } make dup [ insn-available? ] all? ] ;
 | 
					    '[ _ ndup _ { } make dup [ insn-available? ] all? ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
GENERIC#: >vector-op-cond 2 ( quot #pick #dup -- quotpair )
 | 
					GENERIC#: >vector-op-cond 2 ( quot #pick #dup -- quotpair )
 | 
				
			||||||
M:: callable >vector-op-cond ( quot #pick #dup -- quotpair )
 | 
					M:: callable >vector-op-cond ( quot #pick #dup -- quotpair )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -103,7 +103,7 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: change-insn-gc-roots ( gc-map-insn quot: ( x -- x ) -- )
 | 
					: change-insn-gc-roots ( gc-map-insn quot: ( x -- x ) -- )
 | 
				
			||||||
    [ gc-map>> ] dip [ swap gc-roots>> swap map! drop ]
 | 
					    [ gc-map>> ] dip [ swap gc-roots>> swap map! drop ]
 | 
				
			||||||
    [ '[ [ [ @ ] bi@ ] assoc-map ] change-derived-roots drop ] 2bi ; inline
 | 
					    [ '[ [ _ bi@ ] assoc-map ] change-derived-roots drop ] 2bi ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: spill-required? ( live-interval root-leaders n -- ? )
 | 
					: spill-required? ( live-interval root-leaders n -- ? )
 | 
				
			||||||
    [ [ vreg>> ] dip sets:in? ] [ swap covers? ] bi-curry* bi or ;
 | 
					    [ [ vreg>> ] dip sets:in? ] [ swap covers? ] bi-curry* bi or ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -300,7 +300,7 @@ CONSTANT: lookup-table-at-max 256
 | 
				
			||||||
\ at* [ at-quot ] 1 define-partial-eval
 | 
					\ at* [ at-quot ] 1 define-partial-eval
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: diff-quot ( seq -- quot: ( seq' -- seq'' ) )
 | 
					: diff-quot ( seq -- quot: ( seq' -- seq'' ) )
 | 
				
			||||||
    [ tester ] keep '[ members [ @ ] reject _ set-like ] ;
 | 
					    [ tester ] keep '[ members _ reject _ set-like ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M\ sets:set diff [ diff-quot ] 1 define-partial-eval
 | 
					M\ sets:set diff [ diff-quot ] 1 define-partial-eval
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -214,7 +214,7 @@ CONSTANT: log10-2 0x1.34413509f79ffp-2
 | 
				
			||||||
: (bignum-log) ( n log-quot: ( x -- y ) log-2 -- log )
 | 
					: (bignum-log) ( n log-quot: ( x -- y ) log-2 -- log )
 | 
				
			||||||
    [ dup ] dip '[
 | 
					    [ dup ] dip '[
 | 
				
			||||||
        dup representable-as-float?
 | 
					        dup representable-as-float?
 | 
				
			||||||
        [ >float @ ] [ frexp [ @ ] [ _ * ] bi* + ] if
 | 
					        [ >float @ ] [ frexp _ [ _ * ] bi* + ] if
 | 
				
			||||||
    ] call ; inline
 | 
					    ] call ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
PRIVATE>
 | 
					PRIVATE>
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -237,7 +237,7 @@ M: sequence square-cols
 | 
				
			||||||
    [ length ] keep [ <array> ] with { } map-as ;
 | 
					    [ length ] keep [ <array> ] with { } map-as ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: make-matrix-with-indices ( m n quot -- matrix )
 | 
					: make-matrix-with-indices ( m n quot -- matrix )
 | 
				
			||||||
    [ [ <iota> ] bi@ ] dip '[ @ ] cartesian-map ; inline
 | 
					    [ [ <iota> ] bi@ ] dip cartesian-map ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: null-matrix? ( matrix -- ? ) empty? ; inline
 | 
					: null-matrix? ( matrix -- ? ) empty? ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -123,7 +123,7 @@ PRIVATE>
 | 
				
			||||||
MACRO: unpack ( str -- quot )
 | 
					MACRO: unpack ( str -- quot )
 | 
				
			||||||
    expand-pack-format
 | 
					    expand-pack-format
 | 
				
			||||||
    [ [ ch>packed-length ] { } map-as start/end ]
 | 
					    [ [ ch>packed-length ] { } map-as start/end ]
 | 
				
			||||||
    [ [ unpack-table at '[ @ ] ] { } map-as ] bi
 | 
					    [ [ unpack-table at ] { } map-as ] bi
 | 
				
			||||||
    [ '[ [ _ _ ] dip <slice> @ ] ] 3map
 | 
					    [ '[ [ _ _ ] dip <slice> @ ] ] 3map
 | 
				
			||||||
    '[ [ _ cleave ] output>array ] ;
 | 
					    '[ [ _ cleave ] output>array ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -122,7 +122,7 @@ M: f (literal) current-word get bad-macro-input ;
 | 
				
			||||||
GENERIC: known>callable ( known -- quot )
 | 
					GENERIC: known>callable ( known -- quot )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: ?@ ( x -- y )
 | 
					: ?@ ( x -- y )
 | 
				
			||||||
    dup callable? [ drop [ @ ] ] unless ;
 | 
					    dup callable? [ drop _ ] unless ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
M: object known>callable drop \ _ ;
 | 
					M: object known>callable drop \ _ ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -6,6 +6,6 @@ IN: changer
 | 
				
			||||||
MACRO: inline-changer ( name -- quot' )
 | 
					MACRO: inline-changer ( name -- quot' )
 | 
				
			||||||
    [ ">>" append ] [ ">>" prepend ] bi
 | 
					    [ ">>" append ] [ ">>" prepend ] bi
 | 
				
			||||||
    [ "accessors" lookup-word 1quotation ] bi@
 | 
					    [ "accessors" lookup-word 1quotation ] bi@
 | 
				
			||||||
    '[ over [ [ @ ] dip call ] dip swap @ ] ;
 | 
					    '[ over [ _ dip call ] dip swap @ ] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
SYNTAX: change: scan-token '[ _ inline-changer ] append! ;
 | 
					SYNTAX: change: scan-token '[ _ inline-changer ] append! ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -9,7 +9,7 @@ IN: io.random
 | 
				
			||||||
<PRIVATE
 | 
					<PRIVATE
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: each-numbered-line ( ... quot: ( ... line number -- ... ) -- ... )
 | 
					: each-numbered-line ( ... quot: ( ... line number -- ... ) -- ... )
 | 
				
			||||||
    [ 1 ] dip '[ swap [ @ ] [ 1 + ] bi ] each-line drop ; inline
 | 
					    [ 1 ] dip '[ swap _ [ 1 + ] bi ] each-line drop ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
PRIVATE>
 | 
					PRIVATE>
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -95,7 +95,7 @@ FUNCTION: c-string udev_list_entry_get_value (
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! Helper to iterate over all entries of a list.
 | 
					! Helper to iterate over all entries of a list.
 | 
				
			||||||
: udev_list_entry_foreach ( ... first_entry quot: ( ... x -- ... ) -- ... )
 | 
					: udev_list_entry_foreach ( ... first_entry quot: ( ... x -- ... ) -- ... )
 | 
				
			||||||
    [ [ dup ] ] dip '[ [ @ ] keep udev_list_entry_get_next ]
 | 
					    [ [ dup ] ] dip '[ _ keep udev_list_entry_get_next ]
 | 
				
			||||||
    while drop ; inline
 | 
					    while drop ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! Get all list entries _as_ a list
 | 
					! Get all list entries _as_ a list
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -84,7 +84,7 @@ PRIVATE>
 | 
				
			||||||
: (write-message) ( message quot -- )
 | 
					: (write-message) ( message quot -- )
 | 
				
			||||||
    [ connection-buffer dup ] 2dip
 | 
					    [ connection-buffer dup ] 2dip
 | 
				
			||||||
    '[
 | 
					    '[
 | 
				
			||||||
        [ _ [ write-header ] [ @ ] bi ] with-length-prefix
 | 
					        [ _ [ write-header ] _ bi ] with-length-prefix
 | 
				
			||||||
    ] with-output-stream* write flush ; inline
 | 
					    ] with-output-stream* write flush ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
:: build-query-object ( query -- selector )
 | 
					:: build-query-object ( query -- selector )
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -23,7 +23,7 @@ IN: tools.image-analyzer.utils
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: until-eof-reader ( reader-quot -- reader-quot' )
 | 
					: until-eof-reader ( reader-quot -- reader-quot' )
 | 
				
			||||||
    '[
 | 
					    '[
 | 
				
			||||||
        [ [ @ ] throw-on-eof ] [
 | 
					        [ _ throw-on-eof ] [
 | 
				
			||||||
            dup stream-exhausted? [ drop f ] [ throw ] if
 | 
					            dup stream-exhausted? [ drop f ] [ throw ] if
 | 
				
			||||||
        ] recover
 | 
					        ] recover
 | 
				
			||||||
    ] ; inline
 | 
					    ] ; inline
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue