C: <column> column
M: column virtual-seq seq>> ;
-M: column virtual@ dup col>> -rot seq>> nth bounds-check ;
+M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ;
M: column length seq>> length ;
INSTANCE: column virtual-sequence
M: disjoint-set add-atom
[ dupd parents>> set-at ]
- [ 0 -rot ranks>> set-at ]
- [ 1 -rot counts>> set-at ]
+ [ [ 0 ] 2dip ranks>> set-at ]
+ [ [ 1 ] 2dip counts>> set-at ]
2tri ;
: add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
USING: accessors arrays generic hashtables io kernel assocs math
namespaces prettyprint sequences strings io.styles vectors words
quotations mirrors splitting math.parser classes vocabs refs
-sets sorting summary debugger continuations ;
+sets sorting summary debugger continuations fry ;
IN: inspector
: value-editor ( path -- )
[ drop ] [
dup enum? [ +sequence+ on ] when
standard-table-style [
- swap [ -rot describe-row ] curry each-index
+ swap '[ [ _ ] 2dip describe-row ] each-index
] tabular-output
] if-empty ;
: namestack. ( seq -- )
[ [ global eq? not ] filter [ keys ] gather ] keep
- [ dupd assoc-stack ] curry H{ } map>assoc describe ;
+ '[ dup _ assoc-stack ] H{ } map>assoc describe ;
: .vars ( -- )
namestack namestack. ;
[ dup ] 2dip 2curry annotate ;\r
\r
: call-logging-quot ( quot word level -- quot' )\r
- "called" -rot [ log-message ] 3curry prepose ;\r
+ [ "called" ] 2dip [ log-message ] 3curry prepose ;\r
\r
: add-logging ( word level -- )\r
[ call-logging-quot ] (define-logging) ;\r
\r
: multiline-header ( -- string ) 20 CHAR: - <string> ; foldable\r
\r
-: (write-message) ( msg name>> level multi? -- )\r
+: (write-message) ( msg word-name level multi? -- )\r
[\r
"[" write multiline-header write "] " write\r
] [\r
] if\r
write bl write ": " write print ;\r
\r
-: write-message ( msg name>> level -- )\r
- rot harvest {\r
- { [ dup empty? ] [ 3drop ] }\r
- { [ dup length 1 = ] [ first -rot f (write-message) ] }\r
+: write-message ( msg word-name level -- )\r
+ [ harvest ] 2dip {\r
+ { [ pick empty? ] [ 3drop ] }\r
+ { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] }\r
[\r
- [ first -rot f (write-message) ] 3keep\r
- rest -rot [ t (write-message) ] 2curry each\r
+ [ [ first ] 2dip f (write-message) ]\r
+ [ [ rest ] 2dip [ t (write-message) ] 2curry each ]\r
+ 3bi\r
]\r
} cond ;\r
\r
: (log-message) ( msg -- )\r
- #! msg: { msg name>> level service }\r
+ #! msg: { msg word-name level service }\r
first4 log-stream [ write-message flush ] with-output-stream* ;\r
\r
: try-dispose ( stream -- )\r
M: ratio > scale > ;
M: ratio >= scale >= ;
-M: ratio + 2dup scale + -rot ratio+d / ;
-M: ratio - 2dup scale - -rot ratio+d / ;
-M: ratio * 2>fraction * [ * ] dip / ;
+M: ratio + [ scale + ] [ ratio+d ] 2bi / ;
+M: ratio - [ scale - ] [ ratio+d ] 2bi / ;
+M: ratio * 2>fraction [ * ] 2bi@ / ;
M: ratio / scale / ;
M: ratio /i scale /i ;
M: ratio /f scale /f ;
-M: ratio mod [ /i ] 2keep rot * - ;
+M: ratio mod 2dup /i * - ;
M: ratio /mod [ /i ] 2keep mod ;
swap set-slot ;
M: mirror delete-at ( key mirror -- )
- f -rot set-at ;
+ [ f ] 2dip set-at ;
M: mirror clear-assoc ( mirror -- )
[ object>> ] [ object-slots ] bi [
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make sequences splitting opengl.gl
-continuations math.parser math arrays sets math.order ;
+continuations math.parser math arrays sets math.order fry ;
IN: opengl.capabilities
: (require-gl) ( thing require-quot make-error-quot -- )
- -rot dupd call
- [ 2drop ]
- [ swap " " make throw ]
- if ; inline
+ [ dupd call [ drop ] ] dip '[ _ " " make throw ] if ; inline
: gl-extensions ( -- seq )
GL_EXTENSIONS glGetString " " split ;
namespaces math.vectors math.constants math.functions
math.parser opengl.gl opengl.glu combinators arrays sequences
splitting words byte-arrays assocs colors accessors
-generalizations locals specialized-arrays.float
+generalizations locals fry specialized-arrays.float
specialized-arrays.uint ;
IN: opengl
: delete-gl-buffer ( id -- )
[ glDeleteBuffers ] (delete-gl-object) ;
-: with-gl-buffer ( binding id quot -- )
- -rot dupd glBindBuffer
- [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline
+:: with-gl-buffer ( binding id quot -- )
+ binding id glBindBuffer
+ quot [ binding 0 glBindBuffer ] [ ] cleanup ; inline
: with-array-element-buffers ( array-buffer element-buffer quot -- )
- -rot GL_ELEMENT_ARRAY_BUFFER swap [
- swap GL_ARRAY_BUFFER -rot with-gl-buffer
+ [ GL_ELEMENT_ARRAY_BUFFER ] 2dip '[
+ GL_ARRAY_BUFFER swap _ with-gl-buffer
] with-gl-buffer ; inline
: <gl-buffer> ( target data hint -- id )
- pick gen-gl-buffer [ [
- [ dup byte-length swap ] dip glBufferData
- ] with-gl-buffer ] keep ;
+ pick gen-gl-buffer [
+ [
+ [ [ byte-length ] keep ] dip glBufferData
+ ] with-gl-buffer
+ ] keep ;
: buffer-offset ( int -- alien )
<alien> ; inline
dup zero? [
2drop epsilon
] [
- 2dup exactly-n
- -rot 1- at-most-n 2choice
+ [ exactly-n ] [ 1- at-most-n ] 2bi 2choice
] if ;
: at-least-n ( parser n -- parser' )
pick empty? [
3drop f
] [
- pick first -rot between? [
+ [ dup first ] 2dip between? [
unclip-slice <parse-result>
] [
drop f
: deep-each ( obj quot: ( elt -- ) -- )
[ call ] 2keep over branch?
- [ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive
+ [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive
: deep-map ( obj quot: ( elt -- elt' ) -- newobj )
[ call ] keep over branch?
- [ [ deep-map ] curry map ] [ drop ] if ; inline recursive
+ [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
: deep-filter ( obj quot: ( elt -- ? ) -- seq )
over [ pusher [ deep-each ] dip ] dip
: (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )
[ call ] 2keep rot [ drop t ] [
over branch? [
- f -rot [ [ nip ] dip (deep-find) ] curry find drop >boolean
+ [ f ] 2dip '[ nip _ (deep-find) ] find drop >boolean
] [ 2drop f f ] if
] if ; inline recursive
: deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline
: deep-all? ( obj quot -- ? )
- [ not ] compose deep-contains? not ; inline
+ '[ @ not ] deep-contains? not ; inline
: deep-member? ( obj seq -- ? )
swap '[
: deep-change-each ( obj quot: ( elt -- elt' ) -- )
over branch? [
- [ [ call ] keep over [ deep-change-each ] dip ] curry change-each
+ '[ _ [ call ] keep over [ deep-change-each ] dip ] change-each
] [ 2drop ] if ; inline recursive
: flatten ( obj -- seq )
vm parent-directory parent-directory ;
: copy-bundle-dir ( bundle-name dir -- )
- bundle-dir over append-path -rot
+ [ bundle-dir prepend-path swap ] keep
"Contents" prepend-path append-path copy-tree ;
: app-plist ( executable bundle-name -- assoc )
<PRIVATE
-: iterate-prep ( n quot -- i n quot ) 0 -rot ; inline
+: iterate-prep ( n quot -- i n quot ) [ 0 ] 2dip ; inline
: if-iterate? ( i n true false -- ) [ 2over < ] 2dip if ; inline
SYMBOL: bootstrapping?
: if-bootstrapping ( true false -- )
- bootstrapping? get -rot if ; inline
+ [ bootstrapping? get ] 2dip if ; inline
: bootstrap-word ( word -- target )
[ target-word ] [ ] if-bootstrapping ;
[ n ] keep [ rot [ v+ ] change-nth ] with with each ;
: normals ( vs is -- ns )
- over length { 0.0 0.0 0.0 } <array> -rot
+ [ [ length { 0.0 0.0 0.0 } <array> ] keep ] dip
[ [ 2dup ] dip normal ] each drop
[ normalize ] map ;