From 02d868dabe29f4a22fd8c29c504f3c7d0bccb3ea Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Wed, 17 Feb 2010 22:25:53 -0600 Subject: [PATCH 01/14] Solution to Project Euler problem 206 --- extra/project-euler/206/206-tests.factor | 4 +++ extra/project-euler/206/206.factor | 46 ++++++++++++++++++++++++ 2 files changed, 50 insertions(+) create mode 100644 extra/project-euler/206/206-tests.factor create mode 100644 extra/project-euler/206/206.factor diff --git a/extra/project-euler/206/206-tests.factor b/extra/project-euler/206/206-tests.factor new file mode 100644 index 0000000000..132adfb05e --- /dev/null +++ b/extra/project-euler/206/206-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.206 tools.test ; +IN: project-euler.206.tests + +[ 1389019170 ] [ euler206 ] unit-test diff --git a/extra/project-euler/206/206.factor b/extra/project-euler/206/206.factor new file mode 100644 index 0000000000..06946d4db7 --- /dev/null +++ b/extra/project-euler/206/206.factor @@ -0,0 +1,46 @@ +! Copyright (c) 2010 Aaron Schaefer. All rights reserved. +! The contents of this file are licensed under the Simplified BSD License +! A copy of the license is available at http://factorcode.org/license.txt +USING: grouping kernel math math.ranges project-euler.common sequences ; +IN: project-euler.206 + +! http://projecteuler.net/index.php?section=problems&id=206 + +! DESCRIPTION +! ----------- + +! Find the unique positive integer whose square has the form +! 1_2_3_4_5_6_7_8_9_0, where each “_” is a single digit. + + +! SOLUTION +! -------- + +! Through mathematical analysis, we know that the number must end in 00, and +! the only way to get the last digits to be 900, is for our answer to end in +! 30 or 70. + +digits 2 group [ first ] map + { 1 2 3 4 5 6 7 8 9 0 } = ; + +: candidates ( -- seq ) + lo lo 40 + [ hi 100 ] bi@ append ; + +PRIVATE> + +: euler206 ( -- answer ) + candidates [ sq form-fitting? ] find-last nip ; + +! [ euler206 ] 100 ave-time +! 321 ms ave run time - 8.33 SD (100 trials) + +SOLUTION: euler206 From 3f53d189fe6789eb7a647f2a59e239e4b41c1de8 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Thu, 18 Feb 2010 20:46:18 -0600 Subject: [PATCH 02/14] update project-euler common files --- extra/project-euler/common/common.factor | 4 ++-- extra/project-euler/project-euler.factor | 27 ++++++++++++------------ 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index a84f4fa48b..6995adcd6a 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007-2009 Aaron Schaefer. +! Copyright (c) 2007-2010 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel lists make math math.functions math.matrices math.primes.miller-rabin math.order math.parser math.primes.factors @@ -19,7 +19,7 @@ IN: project-euler.common ! mediant - #71, #73 ! nth-prime - #7, #69 ! nth-triangle - #12, #42 -! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92 +! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92, #206 ! palindrome? - #4, #36, #55 ! pandigital? - #32, #38 ! pentagonal? - #44, #45 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 66f4296827..ce58e7009a 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,4 +1,4 @@ -! Copyright (c) 2007-2009 Aaron Schaefer, Samuel Tardieu. +! Copyright (c) 2007-2010 Aaron Schaefer, Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: definitions io io.files io.pathnames kernel math math.parser prettyprint project-euler.ave-time sequences vocabs vocabs.loader @@ -14,18 +14,19 @@ USING: definitions io io.files io.pathnames kernel math math.parser project-euler.037 project-euler.038 project-euler.039 project-euler.040 project-euler.041 project-euler.042 project-euler.043 project-euler.044 project-euler.045 project-euler.046 project-euler.047 project-euler.048 - project-euler.049 project-euler.051 project-euler.052 project-euler.053 - project-euler.054 project-euler.055 project-euler.056 project-euler.057 - project-euler.058 project-euler.059 project-euler.062 project-euler.063 - project-euler.065 project-euler.067 project-euler.069 project-euler.071 - project-euler.072 project-euler.073 project-euler.074 project-euler.075 - project-euler.076 project-euler.079 project-euler.081 project-euler.085 - project-euler.092 project-euler.097 project-euler.099 project-euler.100 - project-euler.102 project-euler.112 project-euler.116 project-euler.117 - project-euler.124 project-euler.134 project-euler.148 project-euler.150 - project-euler.151 project-euler.164 project-euler.169 project-euler.173 - project-euler.175 project-euler.186 project-euler.188 project-euler.190 - project-euler.203 project-euler.215 ; + project-euler.049 project-euler.050 project-euler.051 project-euler.052 + project-euler.053 project-euler.054 project-euler.055 project-euler.056 + project-euler.057 project-euler.058 project-euler.059 project-euler.062 + project-euler.063 project-euler.065 project-euler.067 project-euler.069 + project-euler.071 project-euler.072 project-euler.073 project-euler.074 + project-euler.075 project-euler.076 project-euler.079 project-euler.081 + project-euler.085 project-euler.089 project-euler.092 project-euler.097 + project-euler.099 project-euler.100 project-euler.102 project-euler.112 + project-euler.116 project-euler.117 project-euler.124 project-euler.134 + project-euler.148 project-euler.150 project-euler.151 project-euler.164 + project-euler.169 project-euler.173 project-euler.175 project-euler.186 + project-euler.188 project-euler.190 project-euler.203 project-euler.206 + project-euler.215 project-euler.255 ; IN: project-euler Date: Sat, 20 Feb 2010 09:15:05 -0600 Subject: [PATCH 03/14] Solution to Project Euler problem 70 --- extra/project-euler/049/049.factor | 14 +---- extra/project-euler/070/070-tests.factor | 4 ++ extra/project-euler/070/070.factor | 67 ++++++++++++++++++++++++ extra/project-euler/common/common.factor | 24 ++++++--- 4 files changed, 91 insertions(+), 18 deletions(-) create mode 100644 extra/project-euler/070/070-tests.factor create mode 100644 extra/project-euler/070/070.factor diff --git a/extra/project-euler/049/049.factor b/extra/project-euler/049/049.factor index 8b6f635ee4..08244ea023 100644 --- a/extra/project-euler/049/049.factor +++ b/extra/project-euler/049/049.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2009 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays byte-arrays fry hints kernel math math.combinatorics - math.functions math.parser math.primes project-euler.common sequences sets ; +USING: arrays byte-arrays fry kernel math math.combinatorics math.functions + math.parser math.primes project-euler.common sequences sets ; IN: project-euler.049 ! http://projecteuler.net/index.php?section=problems&id=49 @@ -25,16 +25,6 @@ IN: project-euler.049 [ - '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop - ] keep ; - -HINTS: count-digits fixnum ; - -: permutations? ( n m -- ? ) - [ count-digits ] bi@ = ; - : collect-permutations ( seq -- seq ) [ V{ } clone ] [ dup ] bi* [ dupd '[ _ permutations? ] filter diff --git a/extra/project-euler/070/070-tests.factor b/extra/project-euler/070/070-tests.factor new file mode 100644 index 0000000000..d402b16902 --- /dev/null +++ b/extra/project-euler/070/070-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.070 tools.test ; +IN: project-euler.070.tests + +[ 8319823 ] [ euler070 ] unit-test diff --git a/extra/project-euler/070/070.factor b/extra/project-euler/070/070.factor new file mode 100644 index 0000000000..eed179851e --- /dev/null +++ b/extra/project-euler/070/070.factor @@ -0,0 +1,67 @@ +! Copyright (c) 2010 Aaron Schaefer. All rights reserved. +! The contents of this file are licensed under the Simplified BSD License +! A copy of the license is available at http://factorcode.org/license.txt +USING: arrays assocs combinators.short-circuit kernel math math.combinatorics + math.functions math.primes math.ranges project-euler.common sequences ; +IN: project-euler.070 + +! http://projecteuler.net/index.php?section=problems&id=70 + +! DESCRIPTION +! ----------- + +! Euler's Totient function, φ(n) [sometimes called the phi function], is used +! to determine the number of positive numbers less than or equal to n which are +! relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less +! than nine and relatively prime to nine, φ(9)=6. The number 1 is considered to +! be relatively prime to every positive number, so φ(1)=1. + +! Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation +! of 79180. + +! Find the value of n, 1 < n < 10^(7), for which φ(n) is a permutation of n and +! the ratio n/φ(n) produces a minimum. + + +! SOLUTION +! -------- + +! For n/φ(n) to be minimised, φ(n) must be as close to n as possible; that is, +! we want to maximise φ(n). The minimal solution for n/φ(n) would be if n was +! prime giving n/(n-1) but since n-1 never is a permutation of n it cannot be +! prime. + +! The next best thing would be if n only consisted of 2 prime factors close to +! (in this case) sqrt(10000000). Hence n = p1*p2 and we only need to search +! through a list of known prime pairs. In addition: + +! φ(p1*p2) = p1*p2*(1-1/p1)(1-1/p2) = (p1-1)(p2-1) + +! ...so we can compute φ(n) more efficiently. + +integer 1000 [ - ] [ + ] 2bi primes-between ; inline + +: n-and-phi ( seq -- seq' ) + #! ( seq = { p1, p2 } -- seq' = { n, φ(n) } ) + [ product ] [ [ 1 - ] map product ] bi 2array ; + +: fit-requirements? ( seq -- ? ) + first2 { [ drop 7 10^ < ] [ permutations? ] } 2&& ; + +: minimum-ratio ( seq -- n ) + [ [ first2 / ] map [ infimum ] keep index ] keep nth first ; + +PRIVATE> + +: euler070 ( -- answer ) + likely-prime-factors 2 all-combinations [ n-and-phi ] map + [ fit-requirements? ] filter minimum-ratio ; + +! [ euler070 ] 100 ave-time +! 379 ms ave run time - 1.15 SD (100 trials) + +SOLUTION: euler070 diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 6995adcd6a..1f29ca0af5 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -1,10 +1,11 @@ ! Copyright (c) 2007-2010 Aaron Schaefer. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel lists make math math.functions math.matrices - math.primes.miller-rabin math.order math.parser math.primes.factors - math.primes.lists math.ranges math.ratios namespaces parser prettyprint - quotations sequences sorting strings unicode.case vocabs vocabs.parser - words ; +! The contents of this file are licensed under the Simplified BSD License +! A copy of the license is available at http://factorcode.org/license.txt +USING: accessors arrays byte-arrays fry hints kernel lists make math + math.functions math.matrices math.order math.parser math.primes.factors + math.primes.lists math.primes.miller-rabin math.ranges math.ratios + namespaces parser prettyprint quotations sequences sorting strings + unicode.case vocabs vocabs.parser words ; IN: project-euler.common ! A collection of words used by more than one Project Euler solution @@ -25,6 +26,7 @@ IN: project-euler.common ! pentagonal? - #44, #45 ! penultimate - #69, #71 ! propagate-all - #18, #67 +! permutations? - #49, #70 ! sum-proper-divisors - #21 ! tau* - #12 ! [uad]-transform - #39, #75 @@ -38,6 +40,13 @@ IN: project-euler.common [ + '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop + ] keep ; + +HINTS: count-digits fixnum ; + : max-children ( seq -- seq ) [ dup length 1 - iota [ nth-pair max , ] with each ] { } make ; @@ -107,6 +116,9 @@ PRIVATE> reverse [ first dup ] [ rest ] bi [ propagate dup ] map nip reverse swap suffix ; +: permutations? ( n m -- ? ) + [ count-digits ] bi@ = ; + : sum-divisors ( n -- sum ) dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ; From 6cc9348dfab6f03628caaaf990e37ddefcc362b4 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 20 Feb 2010 09:16:53 -0600 Subject: [PATCH 04/14] Add PE problem 70 to common project file --- extra/project-euler/project-euler.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index ce58e7009a..4131f41b1f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -18,15 +18,15 @@ USING: definitions io io.files io.pathnames kernel math math.parser project-euler.053 project-euler.054 project-euler.055 project-euler.056 project-euler.057 project-euler.058 project-euler.059 project-euler.062 project-euler.063 project-euler.065 project-euler.067 project-euler.069 - project-euler.071 project-euler.072 project-euler.073 project-euler.074 - project-euler.075 project-euler.076 project-euler.079 project-euler.081 - project-euler.085 project-euler.089 project-euler.092 project-euler.097 - project-euler.099 project-euler.100 project-euler.102 project-euler.112 - project-euler.116 project-euler.117 project-euler.124 project-euler.134 - project-euler.148 project-euler.150 project-euler.151 project-euler.164 - project-euler.169 project-euler.173 project-euler.175 project-euler.186 - project-euler.188 project-euler.190 project-euler.203 project-euler.206 - project-euler.215 project-euler.255 ; + project-euler.070 project-euler.071 project-euler.072 project-euler.073 + project-euler.074 project-euler.075 project-euler.076 project-euler.079 + project-euler.081 project-euler.085 project-euler.089 project-euler.092 + project-euler.097 project-euler.099 project-euler.100 project-euler.102 + project-euler.112 project-euler.116 project-euler.117 project-euler.124 + project-euler.134 project-euler.148 project-euler.150 project-euler.151 + project-euler.164 project-euler.169 project-euler.173 project-euler.175 + project-euler.186 project-euler.188 project-euler.190 project-euler.203 + project-euler.206 project-euler.215 project-euler.255 ; IN: project-euler Date: Sat, 20 Feb 2010 11:20:21 -0600 Subject: [PATCH 05/14] clean up PE solution 255 --- extra/project-euler/255/255.factor | 102 +++++++++++++---------- extra/project-euler/common/common.factor | 3 + 2 files changed, 61 insertions(+), 44 deletions(-) diff --git a/extra/project-euler/255/255.factor b/extra/project-euler/255/255.factor index 57a5c5fec7..40bcce4b90 100644 --- a/extra/project-euler/255/255.factor +++ b/extra/project-euler/255/255.factor @@ -1,49 +1,64 @@ -! Copyright (C) 2009 Jon Harper. +! Copyright (c) 2009 Jon Harper. ! See http://factorcode.org/license.txt for BSD license. -USING: project-euler.common math kernel sequences math.functions math.ranges prettyprint io threads math.parser locals arrays namespaces ; +USING: arrays io kernel locals math math.functions math.parser math.ranges + namespaces prettyprint project-euler.common sequences threads ; IN: project-euler.255 ! http://projecteuler.net/index.php?section=problems&id=255 ! DESCRIPTION ! ----------- -! We define the rounded-square-root of a positive integer n as the square root of n rounded to the nearest integer. -! -! The following procedure (essentially Heron's method adapted to integer arithmetic) finds the rounded-square-root of n: -! -! Let d be the number of digits of the number n. -! If d is odd, set x_(0) = 2×10^((d-1)⁄2). -! If d is even, set x_(0) = 7×10^((d-2)⁄2). -! Repeat: -! -! until x_(k+1) = x_(k). -! + +! We define the rounded-square-root of a positive integer n as the square root +! of n rounded to the nearest integer. + +! The following procedure (essentially Heron's method adapted to integer +! arithmetic) finds the rounded-square-root of n: + +! Let d be the number of digits of the number n. +! If d is odd, set x_(0) = 2×10^((d-1)⁄2). +! If d is even, set x_(0) = 7×10^((d-2)⁄2). + +! Repeat: [see URL for figure ] + +! until x_(k+1) = x_(k). + ! As an example, let us find the rounded-square-root of n = 4321. ! n has 4 digits, so x_(0) = 7×10^((4-2)⁄2) = 70. -! -! Since x_(2) = x_(1), we stop here. -! So, after just two iterations, we have found that the rounded-square-root of 4321 is 66 (the actual square root is 65.7343137…). -! -! The number of iterations required when using this method is surprisingly low. -! For example, we can find the rounded-square-root of a 5-digit integer (10,000 ≤ n ≤ 99,999) with an average of 3.2102888889 iterations (the average value was rounded to 10 decimal places). -! -! Using the procedure described above, what is the average number of iterations required to find the rounded-square-root of a 14-digit number (10^(13) ≤ n < 10^(14))? -! Give your answer rounded to 10 decimal places. -! -! Note: The symbols ⌊x⌋ and ⌈x⌉ represent the floor function and ceiling function respectively. -! - -: euler255 ( -- answer ) - 13 14 (euler255) round-to-10-decimals ; +: euler255 ( -- answer ) + 13 14 (euler255) 10 nth-place ; + +! [ euler255 ] gc time +! Running time: 37.468911341 seconds SOLUTION: euler255 - diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 1f29ca0af5..48520ef565 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -92,6 +92,9 @@ PRIVATE> [ [ 10 * ] [ 1 + ] bi* ] while 2nip ] if-zero ; +: nth-place ( x n -- y ) + 10^ [ * round >integer ] keep /f ; + : nth-prime ( n -- n ) 1 - lprimes lnth ; From 41afc11ccab73524a12b83704e7cb51210802d87 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 20 Feb 2010 13:15:46 -0600 Subject: [PATCH 06/14] minor poker vocab cleanup --- extra/poker/poker-tests.factor | 3 +-- extra/poker/poker.factor | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/extra/poker/poker-tests.factor b/extra/poker/poker-tests.factor index fc10a13659..18f596c0e0 100644 --- a/extra/poker/poker-tests.factor +++ b/extra/poker/poker-tests.factor @@ -1,5 +1,4 @@ -USING: accessors kernel math math.order poker poker.private -tools.test ; +USING: accessors kernel math math.order poker poker.private tools.test ; IN: poker.tests [ 134236965 ] [ "KD" >ckf ] unit-test diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor index 59f50509e4..b33b8e5710 100644 --- a/extra/poker/poker.factor +++ b/extra/poker/poker.factor @@ -1,5 +1,4 @@ -! Copyright (c) 2009 Aaron Schaefer. All rights reserved. -! Copyright (c) 2009 Doug Coleman. +! Copyright (c) 2009 Aaron Schaefer, Doug Coleman. All rights reserved. ! The contents of this file are licensed under the Simplified BSD License ! A copy of the license is available at http://factorcode.org/license.txt USING: accessors arrays ascii assocs binary-search combinators From 957f2d9ff61234ec90cf8c5a8a2aa9ac51ff7e04 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 21 Feb 2010 23:37:33 -0600 Subject: [PATCH 07/14] Check if we're using ttys before starting curses, since initscr exits on error for some dumb reason --- basis/unix/ffi/ffi.factor | 1 + extra/curses/curses-tests.factor | 5 +++-- extra/curses/curses.factor | 7 ++++++- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor index 3882f6fc80..10346cff2c 100644 --- a/basis/unix/ffi/ffi.factor +++ b/basis/unix/ffi/ffi.factor @@ -101,6 +101,7 @@ FUNCTION: uid_t getuid ; FUNCTION: uint htonl ( uint n ) ; FUNCTION: ushort htons ( ushort n ) ; ! FUNCTION: int issetugid ; +FUNCTION: int isatty ( int fildes ) ; FUNCTION: int ioctl ( int fd, ulong request, char* argp ) ; FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; FUNCTION: int listen ( int s, int backlog ) ; diff --git a/extra/curses/curses-tests.factor b/extra/curses/curses-tests.factor index 21463b207b..bd98a7aff1 100644 --- a/extra/curses/curses-tests.factor +++ b/extra/curses/curses-tests.factor @@ -14,5 +14,6 @@ IN: curses.tests 2000000 sleep ] with-curses ; -[ -] [ hello-curses ] unit-test +curses-ok? [ + [ ] [ hello-curses ] unit-test +] when diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 69c6503aa2..dfb1b8672a 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings assocs byte-arrays combinators continuations destructors fry io.encodings.8-bit io io.encodings.string io.encodings.utf8 kernel locals math namespaces prettyprint sequences classes.struct -strings threads curses.ffi ; +strings threads curses.ffi unix.ffi ; IN: curses SYMBOL: curses-windows @@ -19,6 +19,7 @@ ERROR: duplicate-window window ; ERROR: unnamed-window window ; ERROR: window-not-found window ; ERROR: curses-failed ; +ERROR: unsupported-curses-terminal ; : get-window ( string -- window ) dup curses-windows get at* @@ -28,7 +29,11 @@ ERROR: curses-failed ; : curses-error ( n -- ) ERR = [ curses-failed ] when ; +: curses-ok? ( -- ? ) + { 0 1 2 } [ isatty 0 = not ] all? ; + : with-curses ( quot -- ) + curses-ok? [ unsupported-curses-terminal ] unless H{ } clone curses-windows [ initscr curses-error [ From dcd76d2abe08c343d1efccaf94593f28ff21c700 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 21 Feb 2010 22:07:32 -0800 Subject: [PATCH 08/14] windows.com.syntax: don't put c-type words inside stack effect of Interface::Method words --- basis/windows/com/syntax/syntax.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 5e08454d5a..7e93a6e9f8 100644 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -71,7 +71,7 @@ ERROR: no-com-interface interface ; : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect ) swap [ [ second ] map ] - [ dup void? [ drop { } ] [ 1array ] if ] bi* + [ dup void? [ drop { } ] [ name>> 1array ] if ] bi* ; : (define-word-for-function) ( function interface n -- ) From 525a57fa3d84ff7a614f84d933d83558972d9719 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 21 Feb 2010 22:07:53 -0800 Subject: [PATCH 09/14] windows.com: add missing USING: windows.types --- basis/windows/com/com-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor index 329a84ef13..f0b4eadb9f 100644 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -1,5 +1,5 @@ USING: kernel windows.com windows.com.syntax windows.ole32 -alien alien.syntax tools.test libc alien.c-types +windows.types alien alien.syntax tools.test libc alien.c-types namespaces arrays continuations accessors math windows.com.wrapper windows.com.wrapper.private destructors effects compiler.units ; IN: windows.com.tests From a0b3a370b8d19f51e8471c543e0ce447bf548431 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 17 Feb 2010 16:42:53 -0600 Subject: [PATCH 10/14] Fix quirk in open-in-explorer -- msft explorer wouldn't go to previous directory correctly if / was a path separator --- basis/tools/deploy/windows/windows.factor | 7 ++++++- basis/windows/shell32/shell32.factor | 3 --- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor index 1dd60583fa..f52154ccd0 100755 --- a/basis/tools/deploy/windows/windows.factor +++ b/basis/tools/deploy/windows/windows.factor @@ -5,7 +5,8 @@ io.encodings.ascii kernel namespaces sequences locals system splitting tools.deploy.backend tools.deploy.config tools.deploy.config.editor assocs hashtables prettyprint combinators windows.kernel32 windows.shell32 windows.user32 -alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico ; +alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico +io.files.windows.nt ; IN: tools.deploy.windows CONSTANT: app-icon-resource-id "APPICON" @@ -22,6 +23,10 @@ CONSTANT: app-icon-resource-id "APPICON" dup copy-dll deploy-ui? get ".exe" ".com" ? copy-vm ; +: open-in-explorer ( dir -- ) + [ f "open" ] dip absolute-path normalize-separators + f f SW_SHOWNORMAL ShellExecute drop ; + : embed-ico ( vm vocab -- ) dup vocab-windows-icon-path vocab-append-path dup exists? [ binary file-contents app-icon-resource-id embed-icon-resource ] diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 08474d4bdd..30104e7723 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -87,9 +87,6 @@ ALIAS: SHGetFolderPath SHGetFolderPathW FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ; ALIAS: ShellExecute ShellExecuteW -: open-in-explorer ( dir -- ) - [ f "open" ] dip absolute-path f f SW_SHOWNORMAL ShellExecute drop ; - : shell32-directory ( n -- str ) f swap f SHGFP_TYPE_DEFAULT MAX_UNICODE_PATH From 82e773f8ba97411758b42351afe453962aa3f5dd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 17 Feb 2010 16:43:53 -0600 Subject: [PATCH 11/14] Add some more win32 symbols --- basis/windows/advapi32/advapi32.factor | 12 +- basis/windows/user32/user32.factor | 149 ++++++++++++++++++++++++- 2 files changed, 158 insertions(+), 3 deletions(-) diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor index fa478b03ed..d5fe33b745 100644 --- a/basis/windows/advapi32/advapi32.factor +++ b/basis/windows/advapi32/advapi32.factor @@ -405,7 +405,7 @@ CONSTANT: KEY_READ HEX: 20019 CONSTANT: KEY_WOW64_32KEY HEX: 0200 CONSTANT: KEY_WOW64_64KEY HEX: 0100 CONSTANT: KEY_WRITE HEX: 20006 -CONSTANT: KEY_EXECUTE KEY_READ +ALIAS: KEY_EXECUTE KEY_READ CONSTANT: KEY_ALL_ACCESS HEX: F003F CONSTANT: REG_NONE 0 @@ -423,6 +423,9 @@ CONSTANT: REG_RESOURCE_REQUIREMENTS_LIST 10 CONSTANT: REG_QWORD 11 CONSTANT: REG_QWORD_LITTLE_ENDIAN 11 +CONSTANT: REG_CREATED_NEW_KEY 1 +CONSTANT: REG_OPENED_EXISTING_KEY 2 + TYPEDEF: DWORD REGSAM ! : I_ScGetCurrentGroupStateW ; @@ -926,6 +929,7 @@ FUNCTION: LONG RegCloseKey ( HKEY hKey ) ; ! : RegCreateKeyA ; ! : RegCreateKeyExA ; FUNCTION: LONG RegCreateKeyExW ( HKEY hKey, LPCTSTR lpSubKey, DWORD Reserved, LPTSTR lpClass, DWORD dwOptions, REGSAM samDesired, LPSECURITY_ATTRIBUTES lpSecurityAttributes, PHKEY phkResult, LPDWORD lpdwDisposition ) ; +ALIAS: RegCreateKeyEx RegCreateKeyExW ! : RegCreateKeyW ! : RegDeleteKeyA ; ! : RegDeleteKeyW ; @@ -949,6 +953,7 @@ ALIAS: RegDeleteKeyEx RegDeleteKeyExW ! : RegDisablePredefinedCache ; ! : RegEnumKeyA ; ! : RegEnumKeyExA ; + FUNCTION: LONG RegEnumKeyExW ( HKEY hKey, DWORD dwIndex, @@ -959,6 +964,8 @@ FUNCTION: LONG RegEnumKeyExW ( LPDWORD lpcClass, PFILETIME lpftLastWriteTime ) ; +ALIAS: RegEnumKeyEx RegEnumKeyExW + ! : RegEnumKeyW ; ! : RegEnumValueA ; @@ -1023,7 +1030,8 @@ ALIAS: RegQueryValueEx RegQueryValueExW ! : RegSetValueA ; ! : RegSetValueExA ; ! : RegSetValueExW ; -! : RegSetValueW ; +FUNCTION: LONG RegSetValueExW ( HKEY hKey, LPCTSTR lpValueName, DWORD Reserved, DWORD dwType, BYTE* lpData, DWORD cbData ) ; +ALIAS: RegSetValueEx RegSetValueExW ! : RegUnLoadKeyA ; ! : RegUnLoadKeyW ; ! : RegisterEventSourceA ; diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index 15eb9ba2f5..27636271cb 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -608,6 +608,150 @@ CONSTANT: MF_HELP HEX: 4000 CONSTANT: MF_RIGHTJUSTIFY HEX: 4000 CONSTANT: MF_MOUSESELECT HEX: 8000 +CONSTANT: SPI_GETBEEP 1 +CONSTANT: SPI_SETBEEP 2 +CONSTANT: SPI_GETMOUSE 3 +CONSTANT: SPI_SETMOUSE 4 +CONSTANT: SPI_GETBORDER 5 +CONSTANT: SPI_SETBORDER 6 +CONSTANT: SPI_GETKEYBOARDSPEED 10 +CONSTANT: SPI_SETKEYBOARDSPEED 11 +CONSTANT: SPI_LANGDRIVER 12 +CONSTANT: SPI_ICONHORIZONTALSPACING 13 +CONSTANT: SPI_GETSCREENSAVETIMEOUT 14 +CONSTANT: SPI_SETSCREENSAVETIMEOUT 15 +CONSTANT: SPI_GETSCREENSAVEACTIVE 16 +CONSTANT: SPI_SETSCREENSAVEACTIVE 17 +CONSTANT: SPI_GETGRIDGRANULARITY 18 +CONSTANT: SPI_SETGRIDGRANULARITY 19 +CONSTANT: SPI_SETDESKWALLPAPER 20 +CONSTANT: SPI_SETDESKPATTERN 21 +CONSTANT: SPI_GETKEYBOARDDELAY 22 +CONSTANT: SPI_SETKEYBOARDDELAY 23 +CONSTANT: SPI_ICONVERTICALSPACING 24 +CONSTANT: SPI_GETICONTITLEWRAP 25 +CONSTANT: SPI_SETICONTITLEWRAP 26 +CONSTANT: SPI_GETMENUDROPALIGNMENT 27 +CONSTANT: SPI_SETMENUDROPALIGNMENT 28 +CONSTANT: SPI_SETDOUBLECLKWIDTH 29 +CONSTANT: SPI_SETDOUBLECLKHEIGHT 30 +CONSTANT: SPI_GETICONTITLELOGFONT 31 +CONSTANT: SPI_SETDOUBLECLICKTIME 32 +CONSTANT: SPI_SETMOUSEBUTTONSWAP 33 +CONSTANT: SPI_SETICONTITLELOGFONT 34 +CONSTANT: SPI_GETFASTTASKSWITCH 35 +CONSTANT: SPI_SETFASTTASKSWITCH 36 +CONSTANT: SPI_SETDRAGFULLWINDOWS 37 +CONSTANT: SPI_GETDRAGFULLWINDOWS 38 + +CONSTANT: SPI_GETFILTERKEYS 50 +CONSTANT: SPI_SETFILTERKEYS 51 +CONSTANT: SPI_GETTOGGLEKEYS 52 +CONSTANT: SPI_SETTOGGLEKEYS 53 +CONSTANT: SPI_GETMOUSEKEYS 54 +CONSTANT: SPI_SETMOUSEKEYS 55 +CONSTANT: SPI_GETSHOWSOUNDS 56 +CONSTANT: SPI_SETSHOWSOUNDS 57 +CONSTANT: SPI_GETSTICKYKEYS 58 +CONSTANT: SPI_SETSTICKYKEYS 59 +CONSTANT: SPI_GETACCESSTIMEOUT 60 +CONSTANT: SPI_SETACCESSTIMEOUT 61 + +CONSTANT: SPI_GETSOUNDSENTRY 64 +CONSTANT: SPI_SETSOUNDSENTRY 65 + +! WINVER >= 0x0400 +CONSTANT: SPI_GETNONCLIENTMETRICS 41 +CONSTANT: SPI_SETNONCLIENTMETRICS 42 +CONSTANT: SPI_GETMINIMIZEDMETRICS 43 +CONSTANT: SPI_SETMINIMIZEDMETRICS 44 +CONSTANT: SPI_GETICONMETRICS 45 +CONSTANT: SPI_SETICONMETRICS 46 +CONSTANT: SPI_SETWORKAREA 47 +CONSTANT: SPI_GETWORKAREA 48 +CONSTANT: SPI_SETPENWINDOWS 49 + +CONSTANT: SPI_GETSERIALKEYS 62 +CONSTANT: SPI_SETSERIALKEYS 63 +CONSTANT: SPI_GETHIGHCONTRAST 66 +CONSTANT: SPI_SETHIGHCONTRAST 67 +CONSTANT: SPI_GETKEYBOARDPREF 68 +CONSTANT: SPI_SETKEYBOARDPREF 69 +CONSTANT: SPI_GETSCREENREADER 70 +CONSTANT: SPI_SETSCREENREADER 71 +CONSTANT: SPI_GETANIMATION 72 +CONSTANT: SPI_SETANIMATION 73 +CONSTANT: SPI_GETFONTSMOOTHING 74 +CONSTANT: SPI_SETFONTSMOOTHING 75 +CONSTANT: SPI_SETDRAGWIDTH 76 +CONSTANT: SPI_SETDRAGHEIGHT 77 +CONSTANT: SPI_SETHANDHELD 78 +CONSTANT: SPI_GETLOWPOWERTIMEOUT 79 +CONSTANT: SPI_GETPOWEROFFTIMEOUT 80 +CONSTANT: SPI_SETLOWPOWERTIMEOUT 81 +CONSTANT: SPI_SETPOWEROFFTIMEOUT 82 +CONSTANT: SPI_GETLOWPOWERACTIVE 83 +CONSTANT: SPI_GETPOWEROFFACTIVE 84 +CONSTANT: SPI_SETLOWPOWERACTIVE 85 +CONSTANT: SPI_SETPOWEROFFACTIVE 86 +CONSTANT: SPI_SETCURSORS 87 +CONSTANT: SPI_SETICONS 88 +CONSTANT: SPI_GETDEFAULTINPUTLANG 89 +CONSTANT: SPI_SETDEFAULTINPUTLANG 90 +CONSTANT: SPI_SETLANGTOGGLE 91 +CONSTANT: SPI_GETWINDOWSEXTENSION 92 +CONSTANT: SPI_SETMOUSETRAILS 93 +CONSTANT: SPI_GETMOUSETRAILS 94 +CONSTANT: SPI_SETSCREENSAVERRUNNING 97 +ALIAS: SPI_SCREENSAVERRUNNING SPI_SETSCREENSAVERRUNNING + +! WIN32_WINNT >= 0x0400 || WIN32_WINDOWS > 0x0400 +CONSTANT: SPI_GETMOUSEHOVERWIDTH 98 +CONSTANT: SPI_SETMOUSEHOVERWIDTH 99 +CONSTANT: SPI_GETMOUSEHOVERHEIGHT 100 +CONSTANT: SPI_SETMOUSEHOVERHEIGHT 101 +CONSTANT: SPI_GETMOUSEHOVERTIME 102 +CONSTANT: SPI_SETMOUSEHOVERTIME 103 +CONSTANT: SPI_GETWHEELSCROLLLINES 104 +CONSTANT: SPI_SETWHEELSCROLLLINES 105 + +CONSTANT: SPI_GETSHOWIMEUI 110 +CONSTANT: SPI_SETSHOWIMEUI 111 + +! WINVER >= 0x0500 +CONSTANT: SPI_GETMOUSESPEED 112 +CONSTANT: SPI_SETMOUSESPEED 113 +CONSTANT: SPI_GETSCREENSAVERRUNNING 114 + +CONSTANT: SPI_GETACTIVEWINDOWTRACKING HEX: 1000 +CONSTANT: SPI_SETACTIVEWINDOWTRACKING HEX: 1001 +CONSTANT: SPI_GETMENUANIMATION HEX: 1002 +CONSTANT: SPI_SETMENUANIMATION HEX: 1003 +CONSTANT: SPI_GETCOMBOBOXANIMATION HEX: 1004 +CONSTANT: SPI_SETCOMBOBOXANIMATION HEX: 1005 +CONSTANT: SPI_GETLISTBOXSMOOTHSCROLLING HEX: 1006 +CONSTANT: SPI_SETLISTBOXSMOOTHSCROLLING HEX: 1007 +CONSTANT: SPI_GETGRADIENTCAPTIONS HEX: 1008 +CONSTANT: SPI_SETGRADIENTCAPTIONS HEX: 1009 +CONSTANT: SPI_GETMENUUNDERLINES HEX: 100A +CONSTANT: SPI_SETMENUUNDERLINES HEX: 100B +CONSTANT: SPI_GETACTIVEWNDTRKZORDER HEX: 100C +CONSTANT: SPI_SETACTIVEWNDTRKZORDER HEX: 100D +CONSTANT: SPI_GETHOTTRACKING HEX: 100E +CONSTANT: SPI_SETHOTTRACKING HEX: 100F +CONSTANT: SPI_GETFOREGROUNDLOCKTIMEOUT HEX: 2000 +CONSTANT: SPI_SETFOREGROUNDLOCKTIMEOUT HEX: 2001 +CONSTANT: SPI_GETACTIVEWNDTRKTIMEOUT HEX: 2002 +CONSTANT: SPI_SETACTIVEWNDTRKTIMEOUT HEX: 2003 +CONSTANT: SPI_GETFOREGROUNDFLASHCOUNT HEX: 2004 +CONSTANT: SPI_SETFOREGROUNDFLASHCOUNT HEX: 2005 + +! SystemParamInfo Flags +CONSTANT: SPIF_UPDATEINIFILE 1 +CONSTANT: SPIF_SENDWININICHANGE 2 +ALIAS: SPIF_SENDCHANGE SPIF_SENDWININICHANGE + + TYPEDEF: HANDLE HRAWINPUT : GET_RAWINPUT_CODE_WPARAM ( wParam -- n ) HEX: ff bitand ; inline @@ -1578,7 +1722,10 @@ FUNCTION: BOOL ShowWindow ( HWND hWnd, int nCmdShow ) ; ! FUNCTION: SwitchDesktop ! FUNCTION: SwitchToThisWindow ! FUNCTION: SystemParametersInfoA -! FUNCTION: SystemParametersInfoW + +FUNCTION: BOOL SystemParametersInfoW ( UINT uiAction, UINT uiParam, PVOID pvParam, UINT fWinIni ) ; +ALIAS: SystemParametersInfo SystemParametersInfoW + ! FUNCTION: TabbedTextOutA ! FUNCTION: TabbedTextOutW ! FUNCTION: TileChildWindows From bb06e4671a49b1fa926097617e7121ac280e8e63 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 22 Feb 2010 00:20:00 -0600 Subject: [PATCH 12/14] Require that g++ or cl be present to use factor.sh --- build-support/factor.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/build-support/factor.sh b/build-support/factor.sh index a02a2fad7e..3a5fb4e253 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -107,6 +107,7 @@ check_installed_programs() { ensure_program_installed git ensure_program_installed wget curl ensure_program_installed gcc + ensure_program_installed g++ cl ensure_program_installed make gmake ensure_program_installed md5sum md5 ensure_program_installed cut From db3a23ffe05184f54c798972e2d3f7345ac2f33a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 22 Feb 2010 19:15:53 +1300 Subject: [PATCH 13/14] parser: auto-use prefers non-private words to private words --- core/parser/parser.factor | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index e23673a479..544d75b244 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.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: arrays definitions generic assocs kernel math namespaces sequences strings vectors words words.symbol quotations io @@ -33,11 +33,19 @@ SYMBOL: auto-use? [ "Added \"" "\" vocabulary to search path" surround note. ] bi ] [ create-in ] if ; +: ignore-forwards ( seq -- seq' ) + [ forward-reference? not ] filter ; + +: private? ( word -- ? ) vocabulary>> ".private" tail? ; + +: ignore-privates ( seq -- seq' ) + dup [ private? ] all? [ [ private? not ] filter ] unless ; + : no-word ( name -- newword ) - dup words-named [ forward-reference? not ] filter - dup length 1 = auto-use? get and - [ nip first no-word-restarted ] - [ throw-restarts no-word-restarted ] + dup words-named ignore-forwards + dup ignore-privates dup length 1 = auto-use? get and + [ 2nip first no-word-restarted ] + [ drop throw-restarts no-word-restarted ] if ; : parse-word ( string -- word/number ) From 2c34ecbdb54a5f5900c27184be1bac45b84c4329 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 22 Feb 2010 19:21:56 +1300 Subject: [PATCH 14/14] stack-checker.dependencies: add depends-on-c-type --- .../stack-checker/dependencies/dependencies.factor | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor index ece943acac..1bd7cdcd31 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs accessors classes classes.algebra fry generic -kernel math namespaces sequences words sets -combinators.short-circuit classes.tuple ; +USING: arrays assocs accessors classes classes.algebra fry +generic kernel math namespaces sequences words sets +combinators.short-circuit classes.tuple alien.c-types ; FROM: classes.tuple.private => tuple-layout ; FROM: assocs => change-at ; IN: stack-checker.dependencies @@ -38,6 +38,13 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ; : depends-on-definition ( word -- ) definition-dependency depends-on ; +GENERIC: depends-on-c-type ( c-type -- ) + +M: c-type-word depends-on-c-type depends-on-definition ; + +M: array depends-on-c-type + [ word? ] filter [ depends-on-definition ] each ; + ! Generic words that the current quotation depends on SYMBOL: generic-dependencies