diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor index 6c50347c3a..ca2f5ed197 100644 --- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -329,3 +329,18 @@ TUPLE: empty-tuple ; [ { vector } declare length>> ] count-unboxed-allocations ] unit-test + +! Bug found while tweaking benchmark.raytracer-simd + +TUPLE: point-2d { x read-only } { y read-only } ; +TUPLE: point-3d < point-2d { z read-only } ; + +[ 0 ] [ + [ { point-2d } declare dup point-3d? [ z>> ] [ x>> ] if ] + count-unboxed-allocations +] unit-test + +[ 0 ] [ + [ point-2d boa dup point-3d? [ z>> ] [ x>> ] if ] + count-unboxed-allocations +] unit-test diff --git a/basis/compiler/tree/escape-analysis/simple/simple.factor b/basis/compiler/tree/escape-analysis/simple/simple.factor index 5be206f2f8..9634bdf259 100644 --- a/basis/compiler/tree/escape-analysis/simple/simple.factor +++ b/basis/compiler/tree/escape-analysis/simple/simple.factor @@ -61,22 +61,28 @@ M: #push escape-analysis* : record-tuple-allocation ( #call -- ) dup immutable-tuple-boa? - [ [ in-d>> but-last ] [ out-d>> first ] bi record-allocation ] + [ [ in-d>> but-last { } like ] [ out-d>> first ] bi record-allocation ] [ record-unknown-allocation ] if ; : slot-offset ( #call -- n/f ) - dup in-d>> - [ second node-value-info literal>> ] - [ first node-value-info class>> ] 2bi - 2dup [ fixnum? ] [ tuple class<= ] bi* and [ - over 2 >= [ drop 2 - ] [ 2drop f ] if + dup in-d>> second node-value-info literal>> dup [ 2 - ] when ; + +: valid-slot-offset? ( slot# in -- ? ) + over [ + allocation dup [ + dup array? [ bounds-check? ] [ 2drop f ] if + ] [ 2drop t ] if ] [ 2drop f ] if ; +: unknown-slot-call ( out slot# in -- ) + [ unknown-allocation ] [ drop ] [ add-escaping-value ] tri* ; + : record-slot-call ( #call -- ) - [ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri over + [ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri + 2dup valid-slot-offset? [ [ record-slot-access ] [ copy-slot-value ] 3bi ] - [ [ unknown-allocation ] [ drop ] [ add-escaping-value ] tri* ] + [ unknown-slot-call ] if ; M: #call escape-analysis* diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index da3bd58f74..0077d0f123 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -103,13 +103,10 @@ IN: compiler.tree.propagation.transforms ! Speeds up 2^ : 2^? ( #call -- ? ) - in-d>> first2 [ value-info ] bi@ - [ { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ] - [ class>> fixnum class<= ] - bi* and ; + in-d>> first value-info literal>> 1 eq? ; \ shift [ - 2^? [ + 2^? [ cell-bits tag-bits get - 1 - '[ >fixnum dup 0 < [ 2drop 0 ] [ diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 1797edccf6..39f0a5fec3 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -22,10 +22,6 @@ TUPLE: fd < disposable fd ; ] with-destructors ; : ( n -- fd ) - #! We drop the error code rather than calling io-error, - #! since on OS X 10.3, this operation fails from init-io - #! when running the Factor.app (presumably because fd 0 and - #! 1 are closed). fd new-disposable swap >>fd ; M: fd dispose @@ -197,5 +193,5 @@ TUPLE: mx-port < port mx ; [ drop 0 ] [ (io-error) ] if ] when ; -: ?flag ( n mask symbol -- n ) - pick rot bitand 0 > [ , ] [ drop ] if ; +:: ?flag ( n mask symbol -- n ) + n mask bitand 0 > [ symbol , ] when n ; diff --git a/basis/io/directories/unix/linux/linux.factor b/basis/io/directories/unix/linux/linux.factor index 932cbe230b..3d69c5f890 100644 --- a/basis/io/directories/unix/linux/linux.factor +++ b/basis/io/directories/unix/linux/linux.factor @@ -4,7 +4,7 @@ USING: alien.c-types io.directories.unix kernel system unix classes.struct unix.ffi ; IN: io.directories.unix.linux -M: unix find-next-file ( DIR* -- dirent ) +M: linux find-next-file ( DIR* -- dirent ) dirent f [ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep diff --git a/basis/io/files/info/info.factor b/basis/io/files/info/info.factor index 500fd62cd3..a314361e9d 100644 --- a/basis/io/files/info/info.factor +++ b/basis/io/files/info/info.factor @@ -26,7 +26,7 @@ available-space free-space used-space total-space ; HOOK: file-system-info os ( path -- file-system-info ) { - { [ os unix? ] [ "io.files.info" ] } + { [ os unix? ] [ "io.files.info.unix" ] } { [ os windows? ] [ "io.files.info.windows" ] } } cond require diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index ae493be849..d4e1d2c557 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -163,9 +163,3 @@ M: input summary : write-object ( str obj -- ) presented associate format ; : write-image ( image -- ) [ "" ] dip image associate format ; - -SYMBOL: stack-effect-style -H{ - { foreground COLOR: FactorDarkGreen } - { font-style plain } -} stack-effect-style set-global diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 204f295944..6b301fa97b 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -99,7 +99,7 @@ M: bignum (bit-count) ] if ; : byte-array-bit-count ( byte-array -- n ) - 0 [ byte-bit-count + ] reduce ; + 0 [ byte-bit-count + ] reduce ; inline PRIVATE> diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor index 42a701d60f..bd25438b74 100644 --- a/basis/prettyprint/stylesheet/stylesheet.factor +++ b/basis/prettyprint/stylesheet/stylesheet.factor @@ -42,5 +42,12 @@ PRIVATE> : vocab-style ( vocab -- style ) dim-color colored-presentation-style ; +SYMBOL: stack-effect-style + +H{ + { foreground COLOR: FactorDarkGreen } + { font-style plain } +} stack-effect-style set-global + : effect-style ( effect -- style ) presented associate stack-effect-style get assoc-union ; diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index 5d4a9226ce..c9dfc4a562 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel math sorting words parser io summary quotations sequences prettyprint continuations effects @@ -108,5 +108,5 @@ PRIVATE> : word-timing. ( -- ) word-timing get - >alist [ 1000000 /f ] assoc-map sort-values + >alist [ 1,000,000,000 /f ] assoc-map sort-values simple-table. ; diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 1412e65f95..987b4aa8a1 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -117,3 +117,9 @@ os macosx? [ [ ] [ "tools.deploy.test.16" shake-and-bake run-temp-image ] unit-test [ ] [ "tools.deploy.test.17" shake-and-bake run-temp-image ] unit-test + +[ t ] [ + "tools.deploy.test.18" shake-and-bake + deploy-test-command ascii [ readln ] with-process-reader + "test.image" temp-file = +] unit-test diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 5897712a02..1060853343 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays accessors io.backend io.streams.c init fry -namespaces math make assocs kernel parser parser.notes lexer -strings.parser vocabs sequences sequences.deep sequences.private -words memory kernel.private continuations io vocabs.loader -system strings sets vectors quotations byte-arrays sorting -compiler.units definitions generic generic.standard +USING: arrays accessors io.backend io.pathnames io.streams.c +init fry namespaces math make assocs kernel parser parser.notes +lexer strings.parser vocabs sequences sequences.deep +sequences.private words memory kernel.private continuations io +vocabs.loader system strings sets vectors quotations byte-arrays +sorting compiler.units definitions generic generic.standard generic.single tools.deploy.config combinators classes classes.builtin slots.private grouping command-line ; QUALIFIED: bootstrap.stage2 @@ -43,13 +43,11 @@ IN: tools.deploy.shaker "io.thread" startup-hooks get delete-at ] unless strip-io? [ - "io.files" startup-hooks get delete-at "io.backend" startup-hooks get delete-at "io.thread" startup-hooks get delete-at ] when strip-dictionary? [ { - ! "compiler.units" "vocabs" "vocabs.cache" "source-files.errors" @@ -294,6 +292,9 @@ IN: tools.deploy.shaker input-stream output-stream error-stream + vm + image + current-directory } % "io-thread" "io.thread" lookup , diff --git a/basis/tools/deploy/test/18/18.factor b/basis/tools/deploy/test/18/18.factor new file mode 100644 index 0000000000..0676376701 --- /dev/null +++ b/basis/tools/deploy/test/18/18.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors io.streams.c math.parser system ; +IN: tools.deploy.test.18 + +: main ( -- ) image show ; + +MAIN: main diff --git a/basis/tools/deploy/test/18/authors.txt b/basis/tools/deploy/test/18/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/tools/deploy/test/18/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/tools/deploy/test/18/deploy.factor b/basis/tools/deploy/test/18/deploy.factor new file mode 100644 index 0000000000..66069d6430 --- /dev/null +++ b/basis/tools/deploy/test/18/deploy.factor @@ -0,0 +1,14 @@ +USING: tools.deploy.config ; +H{ + { deploy-name "tools.deploy.test.18" } + { deploy-ui? f } + { deploy-c-types? f } + { deploy-unicode? f } + { "stop-after-last-window?" t } + { deploy-io 1 } + { deploy-reflection 1 } + { deploy-word-props? f } + { deploy-math? f } + { deploy-threads? f } + { deploy-word-defs? f } +} diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index ecbc2e6bc7..0d5a884832 100644 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007, 2009 Daniel Ehrenberg, Slava Pestov, and Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel sequences -sequences.private namespaces math quotations assocs.private ; +sequences.private namespaces math quotations assocs.private +sets ; IN: assocs ARTICLE: "alists" "Association lists" @@ -90,6 +91,8 @@ ARTICLE: "assocs-values" "Transposed assoc operations" ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" "It is often useful to use the keys of an associative mapping as a set, exploiting the constant or logarithmic lookup time of most implementations (" { $link "alists" } " being a notable exception)." +$nl +"Set-theoretic operations:" { $subsections assoc-subset? assoc-intersect @@ -98,6 +101,11 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" substitute extract-keys } +"Adding elements to sets:" +{ $subsections + conjoin + conjoin-at +} "Destructive operations:" { $subsections assoc-union! diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 10a5f674bd..2b02d7c5a1 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -119,3 +119,9 @@ TUPLE: forgotten-predicate-test ; [ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test [ f ] [ \ forgotten-predicate-test? predicate? ] unit-test + +GENERIC: generic-predicate? ( a -- b ) + +[ ] [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test + +[ f ] [ \ generic-predicate? generic? ] unit-test diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 6d68ad7fb4..28f0b192ee 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -59,14 +59,15 @@ PRIVATE> : classes ( -- seq ) implementors-map get keys ; +PREDICATE: predicate < word "predicating" word-prop >boolean ; + : create-predicate-word ( word -- predicate ) - [ name>> "?" append ] [ vocabulary>> ] bi create ; + [ name>> "?" append ] [ vocabulary>> ] bi create + dup predicate? [ dup reset-generic ] unless ; : predicate-word ( word -- predicate ) "predicate" word-prop first ; -PREDICATE: predicate < word "predicating" word-prop >boolean ; - M: predicate flushable? drop t ; M: predicate forget* diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index f452d8fb28..36d402c61d 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -764,3 +764,9 @@ DEFER: factor-crashes-anymore ] unit-test [ 31337 ] [ factor-crashes-anymore ] unit-test + +TUPLE: tuple-predicate-redefine-test ; + +[ ] [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test + +[ t ] [ \ tuple-predicate-redefine-test? predicate? ] unit-test diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 999e963f36..d9b1271152 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -29,8 +29,6 @@ $nl "Adding elements to sets:" { $subsections adjoin - conjoin - conjoin-at } { $see-also member? member-eq? any? all? "assocs-sets" } ; diff --git a/extra/benchmark/raytracer-simd/raytracer-simd.factor b/extra/benchmark/raytracer-simd/raytracer-simd.factor index dcdc911cbf..e90708c62d 100644 --- a/extra/benchmark/raytracer-simd/raytracer-simd.factor +++ b/extra/benchmark/raytracer-simd/raytracer-simd.factor @@ -1,13 +1,14 @@ ! Factor port of the raytracer benchmark from -! http://www.ffconsultancy.com/free/ray_tracer/languages.html +! http://www.ffconsultancy.com/languages/ray_tracer/index.html USING: arrays accessors io io.files io.files.temp io.encodings.binary kernel math math.constants math.functions -math.vectors math.vectors.simd math.vectors.simd.cords math.parser -make sequences sequences.private words hints classes.struct ; -QUALIFIED-WITH: alien.c-types c +math.vectors math.vectors.simd math.vectors.simd.cords +math.parser make sequences words combinators ; IN: benchmark.raytracer-simd +<< SYNTAX: no-compile word t "no-compile" set-word-prop ; >> + ! parameters ! Normalized { -1 -3 2 }. @@ -25,7 +26,7 @@ CONSTANT: levels 3 CONSTANT: size 200 -: delta ( -- n ) epsilon sqrt ; inline +: delta ( -- n ) epsilon sqrt ; inline no-compile TUPLE: ray { orig double-4 read-only } { dir double-4 read-only } ; @@ -35,80 +36,69 @@ TUPLE: hit { normal double-4 read-only } { lambda float read-only } ; C: hit -GENERIC: intersect-scene ( hit ray scene -- hit ) - TUPLE: sphere { center double-4 read-only } { radius float read-only } ; C: sphere -: sphere-v ( sphere ray -- v ) - [ center>> ] [ orig>> ] bi* v- ; inline +: sphere-v ( sphere ray -- v ) [ center>> ] [ orig>> ] bi* v- ; inline no-compile -: sphere-b ( v ray -- b ) - dir>> v. ; inline +: sphere-b ( v ray -- b ) dir>> v. ; inline no-compile -: sphere-d ( sphere b v -- d ) - [ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline +: sphere-d ( sphere b v -- d ) [ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline no-compile -: -+ ( x y -- x-y x+y ) - [ - ] [ + ] 2bi ; inline +: -+ ( x y -- x-y x+y ) [ - ] [ + ] 2bi ; inline no-compile : sphere-t ( b d -- t ) -+ dup 0.0 < - [ 2drop 1/0. ] [ [ [ 0.0 > ] keep ] dip ? ] if ; inline + [ 2drop 1/0. ] [ [ [ 0.0 > ] keep ] dip ? ] if ; inline no-compile : sphere-b&v ( sphere ray -- b v ) [ sphere-v ] [ nip ] 2bi - [ sphere-b ] [ drop ] 2bi ; inline + [ sphere-b ] [ drop ] 2bi ; inline no-compile : ray-sphere ( sphere ray -- t ) [ drop ] [ sphere-b&v ] 2bi [ drop ] [ sphere-d ] 3bi - dup 0.0 < [ 3drop 1/0. ] [ sqrt sphere-t nip ] if ; inline + dup 0.0 < [ 3drop 1/0. ] [ sqrt sphere-t nip ] if ; inline no-compile -: if-ray-sphere ( hit ray sphere quot -- hit ) - #! quot: hit ray sphere l -- hit +: if-ray-sphere ( hit ray sphere quot: ( hit ray sphere l -- hit ) -- hit ) [ [ ] [ swap ray-sphere nip ] [ 2drop lambda>> ] 3tri [ drop ] [ < ] 2bi - ] dip [ 3drop ] if ; inline + ] dip [ 3drop ] if ; inline no-compile : sphere-n ( ray sphere l -- n ) [ [ orig>> ] [ dir>> ] bi ] [ center>> ] [ ] tri* - swap [ v*n ] dip v- v+ ; inline - -M: sphere intersect-scene ( hit ray sphere -- hit ) - [ [ sphere-n normalize ] keep nip ] if-ray-sphere ; - -HINTS: M\ sphere intersect-scene { hit ray sphere } ; + swap [ v*n ] dip v- v+ ; inline no-compile TUPLE: group < sphere { objs array read-only } ; : ( objs bound -- group ) - [ center>> ] [ radius>> ] bi rot group boa ; inline + swap [ [ center>> ] [ radius>> ] bi ] dip group boa ; inline no-compile : make-group ( bound quot -- ) - swap [ { } make ] dip ; inline + swap [ { } make ] dip ; inline no-compile -M: group intersect-scene ( hit ray group -- hit ) - [ drop objs>> [ intersect-scene ] with each ] if-ray-sphere ; - -HINTS: M\ group intersect-scene { hit ray group } ; +: intersect-scene ( hit ray scene -- hit ) + { + { [ dup group? ] [ [ drop objs>> [ intersect-scene ] with each ] if-ray-sphere ] } + { [ dup sphere? ] [ [ [ sphere-n normalize ] keep nip ] if-ray-sphere ] } + } cond ; inline recursive no-compile CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. } : initial-intersect ( ray scene -- hit ) - [ initial-hit ] 2dip intersect-scene ; inline + [ initial-hit ] 2dip intersect-scene ; inline no-compile : ray-o ( ray hit -- o ) [ [ orig>> ] [ normal>> delta v*n ] bi* ] [ [ dir>> ] [ lambda>> ] bi* v*n ] - 2bi v+ v+ ; inline + 2bi v+ v+ ; inline no-compile : sray-intersect ( ray scene hit -- ray ) - swap [ ray-o light vneg ] dip initial-intersect ; inline + swap [ ray-o light vneg ] dip initial-intersect ; inline no-compile -: ray-g ( hit -- g ) normal>> light v. ; inline +: ray-g ( hit -- g ) normal>> light v. ; inline no-compile : cast-ray ( ray scene -- g ) 2dup initial-intersect dup lambda>> 1/0. = [ @@ -116,66 +106,61 @@ CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. } ] [ [ sray-intersect lambda>> 1/0. = ] keep swap [ ray-g neg ] [ drop 0.0 ] if - ] if ; inline + ] if ; inline no-compile : create-center ( c r d -- c2 ) - [ 3.0 12.0 sqrt / * ] dip n*v v+ ; inline + [ 3.0 12.0 sqrt / * ] dip n*v v+ ; inline no-compile DEFER: create ( level c r -- scene ) : create-step ( level c r d -- scene ) over [ create-center ] dip 2.0 / [ 1 - ] 2dip create ; -: create-offsets ( quot -- ) +CONSTANT: create-offsets { double-4{ -1.0 1.0 -1.0 0.0 } double-4{ 1.0 1.0 -1.0 0.0 } double-4{ -1.0 1.0 1.0 0.0 } double-4{ 1.0 1.0 1.0 0.0 } - } swap each ; inline + } : create-bound ( c r -- sphere ) 3.0 * ; : create-group ( level c r -- scene ) 2dup create-bound [ 2dup , - [ [ 3dup ] dip create-step , ] create-offsets 3drop + create-offsets [ create-step , ] with with with each ] make-group ; : create ( level c r -- scene ) pick 1 = [ nip ] [ create-group ] if ; : ss-point ( dx dy -- point ) - [ oversampling /f ] bi@ 0.0 0.0 double-4-boa ; + [ oversampling /f ] bi@ 0.0 0.0 double-4-boa ; inline no-compile -: ss-grid ( -- ss-grid ) - oversampling iota [ oversampling iota [ ss-point ] with map ] map ; +: ray-pixel ( scene point -- ray-grid ) + [ 0.0 ] 2dip + oversampling iota [ + oversampling iota [ + ss-point v+ normalize + double-4{ 0.0 0.0 -4.0 0.0 } swap + swap cast-ray + + ] with with with each + ] with with each ; inline no-compile -: ray-grid ( point ss-grid -- ray-grid ) - [ - [ v+ normalize double-4{ 0.0 0.0 -4.0 0.0 } swap ] with map - ] with map ; - -: ray-pixel ( scene point -- n ) - ss-grid ray-grid [ 0.0 ] 2dip - [ [ swap cast-ray + ] with each ] with each ; - -: pixel-grid ( -- grid ) - size iota reverse [ +: ray-trace ( scene -- grid ) + size iota [ size iota [ [ size 0.5 * - ] bi@ swap size - 0.0 double-4-boa - ] with map - ] map ; + 0.0 double-4-boa ray-pixel + ] with with map + ] with map ; : pgm-header ( w h -- ) "P5\n" % swap # " " % # "\n255\n" % ; : pgm-pixel ( n -- ) 255 * 0.5 + >fixnum , ; -: ray-trace ( scene -- pixels ) - pixel-grid [ [ ray-pixel ] with map ] with map ; - : run ( -- string ) levels double-4{ 0.0 -1.0 0.0 0.0 } 1.0 create ray-trace [ size size pgm-header diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor index 3a3d6a66b7..72c63660e3 100644 --- a/extra/mason/source/source.factor +++ b/extra/mason/source/source.factor @@ -8,11 +8,17 @@ IN: mason.source : clone-factor ( -- ) { "git" "clone" } home "factor" append-path suffix try-process ; +: save-git-id ( -- ) + git-id "git-id" to-file ; + +: delete-git-tree ( -- ) + ".git" delete-tree ; + +: download-images ( -- ) + images [ download-image ] each ; + : prepare-source ( -- ) - "factor" [ - ".git" delete-tree - images [ download-image ] each - ] with-directory ; + "factor" [ save-git-id delete-git-tree download-images ] with-directory ; : package-name ( version -- string ) "factor-src-" ".zip" surround ; diff --git a/basis/math/points/points.factor b/extra/math/points/points.factor similarity index 100% rename from basis/math/points/points.factor rename to extra/math/points/points.factor diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor index ec190fed18..9927486eb7 100644 --- a/extra/project-euler/ave-time/ave-time.factor +++ b/extra/project-euler/ave-time/ave-time.factor @@ -1,11 +1,11 @@ ! Copyright (c) 2007, 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.smart formatting fry io kernel macros math -math.functions math.statistics memory sequences tools.time ; +USING: combinators.smart formatting fry io kernel macros math math.functions +math.statistics memory sequences tools.time ; IN: project-euler.ave-time MACRO: collect-benchmarks ( quot n -- seq ) - swap '[ _ [ [ [ _ nullary ] preserving ] gc benchmark 1000 / ] replicate ] ; + swap '[ _ [ [ [ _ nullary ] preserving ] gc benchmark 6 10^ / ] replicate ] ; : ave-time ( quot n -- ) [