diff --git a/basis/columns/columns.factor b/basis/columns/columns.factor index 5ac8531f58..8f45dab872 100644 --- a/basis/columns/columns.factor +++ b/basis/columns/columns.factor @@ -9,7 +9,7 @@ TUPLE: column seq col ; C: 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 diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index ea246cfa28..a3e5c7ceb7 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -60,8 +60,8 @@ GENERIC: add-atom ( a disjoint-set -- ) 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 ; diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index 6993bcb65b..29f865cf3c 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -153,18 +153,18 @@ GENERIC: next-elt ( loc document elt -- newloc ) TUPLE: char-elt ; : (prev-char) ( loc document quot -- loc ) - -rot { - { [ over { 0 0 } = ] [ drop ] } - { [ over second zero? ] [ [ first 1- ] dip line-end ] } - [ pick call ] - } cond nip ; inline + { + { [ pick { 0 0 } = ] [ 2drop ] } + { [ pick second zero? ] [ drop [ first 1- ] dip line-end ] } + [ call ] + } cond ; inline : (next-char) ( loc document quot -- loc ) - -rot { - { [ 2dup doc-end = ] [ drop ] } - { [ 2dup line-end? ] [ drop first 1+ 0 2array ] } - [ pick call ] - } cond nip ; inline + { + { [ 2over doc-end = ] [ 2drop ] } + { [ 2over line-end? ] [ 2drop first 1+ 0 2array ] } + [ call ] + } cond ; inline M: char-elt prev-elt drop [ drop -1 +col ] (prev-char) ; diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index 0d435a1eaf..4ea90e086b 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -100,14 +100,12 @@ $nl { $code "10 [ \"Factor rocks!\" print ] times" } "Now we can look at a new data type, the array:" { $code "{ 1 2 3 }" } -"An array looks like a quotation except it cannot be evaluated; it simply stores data." +"An array differs from a quotation in that it cannot be evaluated; it simply stores data." $nl "You can perform an operation on each element of an array:" { $example "{ 1 2 3 } [ \"The number is \" write . ] each" - "The number is 1" - "The number is 2" - "The number is 3" + "The number is 1\nThe number is 2\nThe number is 3" } "You can transform each element, collecting the results in a new array:" { $example "{ 5 12 0 -12 -5 } [ sq ] map ." "{ 25 144 0 144 25 }" } diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index b47426f5bb..9c61d092e5 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -3,7 +3,7 @@ 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 -- ) @@ -53,7 +53,7 @@ SYMBOL: +editable+ [ 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 ; @@ -64,7 +64,7 @@ M: tuple error. describe ; : 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. ; diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index fb6b328990..6769932c88 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -61,7 +61,7 @@ PRIVATE> [ dup ] 2dip 2curry annotate ; : call-logging-quot ( quot word level -- quot' ) - "called" -rot [ log-message ] 3curry prepose ; + [ "called" ] 2dip [ log-message ] 3curry prepose ; : add-logging ( word level -- ) [ call-logging-quot ] (define-logging) ; diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index 68f8d74571..618dba544c 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -28,7 +28,7 @@ SYMBOL: log-files : multiline-header ( -- string ) 20 CHAR: - ; foldable -: (write-message) ( msg name>> level multi? -- ) +: (write-message) ( msg word-name level multi? -- ) [ "[" write multiline-header write "] " write ] [ @@ -36,18 +36,19 @@ SYMBOL: log-files ] if write bl write ": " write print ; -: write-message ( msg name>> level -- ) - rot harvest { - { [ dup empty? ] [ 3drop ] } - { [ dup length 1 = ] [ first -rot f (write-message) ] } +: write-message ( msg word-name level -- ) + [ harvest ] 2dip { + { [ pick empty? ] [ 3drop ] } + { [ pick length 1 = ] [ [ first ] 2dip f (write-message) ] } [ - [ first -rot f (write-message) ] 3keep - rest -rot [ t (write-message) ] 2curry each + [ [ first ] 2dip f (write-message) ] + [ [ rest ] 2dip [ t (write-message) ] 2curry each ] + 3bi ] } cond ; : (log-message) ( msg -- ) - #! msg: { msg name>> level service } + #! msg: { msg word-name level service } first4 log-stream [ write-message flush ] with-output-stream* ; : try-dispose ( stream -- ) diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index 81294d29f7..15914e7b05 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -50,11 +50,11 @@ M: ratio <= scale <= ; 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 ; diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index d3d6dbdb04..25486d127d 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -32,7 +32,7 @@ M: mirror set-at ( val key mirror -- ) 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 [ diff --git a/basis/opengl/capabilities/capabilities.factor b/basis/opengl/capabilities/capabilities.factor index 3972fea7b3..09d49b33c2 100755 --- a/basis/opengl/capabilities/capabilities.factor +++ b/basis/opengl/capabilities/capabilities.factor @@ -1,14 +1,11 @@ ! 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 ; diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 10f9c57a83..f5868ee7a1 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -6,7 +6,7 @@ USING: alien alien.c-types continuations kernel libc math macros 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 @@ -154,19 +154,21 @@ MACRO: all-enabled-client-state ( seq quot -- ) : 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 : ( 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 ) ; inline diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index 7434ca6a7a..a9fb366812 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -51,8 +51,7 @@ PRIVATE> 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' ) diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 3fc6fec8ed..206a054d35 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -373,7 +373,7 @@ TUPLE: range-parser min max ; pick empty? [ 3drop f ] [ - pick first -rot between? [ + [ dup first ] 2dip between? [ unclip-slice ] [ drop f diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index 244040d60a..d942b3f4c4 100644 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -14,11 +14,11 @@ M: object branch? 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 @@ -27,7 +27,7 @@ M: object branch? drop f ; : (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 @@ -36,7 +36,7 @@ M: object branch? drop f ; : 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 '[ @@ -50,7 +50,7 @@ M: object branch? drop f ; : 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 ) diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor index 1dcc6fe4c1..91b4d603af 100644 --- a/basis/tools/deploy/macosx/macosx.factor +++ b/basis/tools/deploy/macosx/macosx.factor @@ -13,7 +13,7 @@ IN: tools.deploy.macosx 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 ) diff --git a/basis/uuid/uuid-docs.factor b/basis/uuid/uuid-docs.factor index 0408da85b8..487d5a1104 100644 --- a/basis/uuid/uuid-docs.factor +++ b/basis/uuid/uuid-docs.factor @@ -4,23 +4,27 @@ USING: help.syntax help.markup kernel prettyprint sequences strings ; IN: uuid HELP: uuid1 +{ $values { "string" "a UUID string" } } { $description "Generates a UUID (version 1) from the host ID, sequence number, " "and current time." } ; HELP: uuid3 +{ $values { "namespace" string } { "name" string } { "string" "a UUID string" } } { $description "Generates a UUID (version 3) from the MD5 hash of a namespace " "UUID and a name." } ; HELP: uuid4 +{ $values { "string" "a UUID string" } } { $description "Generates a UUID (version 4) from random bits." } ; HELP: uuid5 +{ $values { "namespace" string } { "name" string } { "string" "a UUID string" } } { $description "Generates a UUID (version 5) from the SHA-1 hash of a namespace " "UUID and a name." @@ -28,12 +32,10 @@ HELP: uuid5 ARTICLE: "uuid" "UUID (Universally Unique Identifier)" -"The " { $vocab-link "uuid" } " vocabulary is used to generate UUID's. " -"The words uuid1, uuid3, uuid4, uuid5 can be used to generate version " -"1, 3, 4, and 5 UUIDs as specified in RFC 4122.\n" -"\n" -"If all you want is a unique ID, you should probably call uuid1 or uuid4." -"\n" +"The " { $vocab-link "uuid" } " vocabulary is used to generate UUIDs. " +"The below words can be used to generate version 1, 3, 4, and 5 UUIDs as specified in RFC 4122." +$nl +"If all you want is a unique ID, you should probably call " { $link uuid1 } " or " { $link uuid4 } "." { $subsection uuid1 } { $subsection uuid3 } { $subsection uuid4 } diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 8b491d7cf2..337ea22df5 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -3,7 +3,7 @@ USING: byte-arrays checksums checksums.md5 checksums.sha1 kernel math math.parser math.ranges random unicode.case -sequences strings system ; +sequences strings system io.binary ; IN: uuid @@ -16,7 +16,8 @@ IN: uuid micros 10 * HEX: 01b21dd213814000 + [ -48 shift HEX: 0fff bitand ] [ -32 shift HEX: ffff bitand ] - [ HEX: ffffffff bitand ] tri ; + [ HEX: ffffffff bitand ] + tri ; : (hardware) ( -- address ) ! Choose a random 48-bit number with eighth bit @@ -35,9 +36,10 @@ IN: uuid bitor ; : (version) ( n version -- n' ) - [ HEX: c000 48 shift bitnot bitand - HEX: 8000 48 shift bitor - HEX: f000 64 shift bitnot bitand + [ + HEX: c000 48 shift bitnot bitand + HEX: 8000 48 shift bitor + HEX: f000 64 shift bitnot bitand ] dip 76 shift bitor ; : uuid>string ( n -- string ) @@ -51,13 +53,7 @@ IN: uuid [ CHAR: - = not ] filter 16 base> ; : uuid>byte-array ( n -- byte-array ) - 16 15 -1 [a,b) [ - [ dup HEX: ff bitand ] 2dip swap - [ set-nth -8 shift ] keep - ] each nip ; - -: byte-array>uuid ( byte-array -- n ) - 0 swap [ [ 8 shift ] dip + ] each ; + 16 >be ; PRIVATE> @@ -65,15 +61,15 @@ PRIVATE> string>uuid uuid>byte-array ; : uuid-unparse ( byte-array -- string ) - byte-array>uuid uuid>string ; + be> uuid>string ; : uuid1 ( -- string ) (hardware) (clock) (timestamp) 1 (version) uuid>string ; : uuid3 ( namespace name -- string ) - [ uuid-parse ] dip >byte-array append - md5 checksum-bytes 16 short head byte-array>uuid + [ uuid-parse ] dip append + md5 checksum-bytes 16 short head be> 3 (version) uuid>string ; : uuid4 ( -- string ) @@ -81,14 +77,13 @@ PRIVATE> 4 (version) uuid>string ; : uuid5 ( namespace name -- string ) - [ uuid-parse ] dip >byte-array append - sha1 checksum-bytes 16 short head byte-array>uuid + [ uuid-parse ] dip append + sha1 checksum-bytes 16 short head be> 5 (version) uuid>string ; - -: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8" ; inline -: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8" ; inline -: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8" ; inline -: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" ; inline +CONSTANT: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8" +CONSTANT: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8" +CONSTANT: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8" +CONSTANT: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" diff --git a/core/math/math.factor b/core/math/math.factor index 7c9be868b3..412fd325cc 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -114,7 +114,7 @@ M: float fp-infinity? ( float -- ? ) -rot + [ [ length { 0.0 0.0 0.0 } ] keep ] dip [ [ 2dup ] dip normal ] each drop [ normalize ] map ; diff --git a/unmaintained/golden-section/authors.txt b/extra/golden-section/authors.txt similarity index 100% rename from unmaintained/golden-section/authors.txt rename to extra/golden-section/authors.txt diff --git a/unmaintained/golden-section/deploy.factor b/extra/golden-section/deploy.factor similarity index 100% rename from unmaintained/golden-section/deploy.factor rename to extra/golden-section/deploy.factor diff --git a/unmaintained/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor similarity index 100% rename from unmaintained/golden-section/golden-section.factor rename to extra/golden-section/golden-section.factor diff --git a/unmaintained/golden-section/summary.txt b/extra/golden-section/summary.txt similarity index 100% rename from unmaintained/golden-section/summary.txt rename to extra/golden-section/summary.txt diff --git a/unmaintained/golden-section/tags.txt b/extra/golden-section/tags.txt similarity index 100% rename from unmaintained/golden-section/tags.txt rename to extra/golden-section/tags.txt diff --git a/extra/size-of/size-of.factor b/extra/size-of/size-of.factor new file mode 100644 index 0000000000..d40ea6f8ba --- /dev/null +++ b/extra/size-of/size-of.factor @@ -0,0 +1,38 @@ + +USING: io io.encodings.ascii io.files io.files.temp io.launcher + locals math.parser sequences sequences.deep ; + +IN: size-of + +! Use 'size-of' to find out the size in bytes of a C type. +! +! The 'headers' argument is a list of header files to use. You may +! pass 'f' to only use 'stdio.h'. +! +! Examples: +! +! f "int" size-of . +! +! { "X11/Xlib.h" } "XAnyEvent" size-of . + +:: size-of ( HEADERS TYPE -- n ) + + [let | C-FILE [ "size-of.c" temp-file ] + EXE-FILE [ "size-of" temp-file ] + INCLUDES [ HEADERS [| FILE | { "#include <" FILE ">" } concat ] map ] | + + { + "#include " + INCLUDES + "main() { printf( \"%i\" , sizeof( " TYPE " ) ) ; }" + } + + flatten C-FILE ascii set-file-lines + + { "gcc" C-FILE "-o" EXE-FILE } try-process + + EXE-FILE ascii contents string>number ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + \ No newline at end of file