Merge branch 'master' into new-alien-pointers
Joe Groff
commit
2a751106a8
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
|
|
|
|||
|
|
@ -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 ) ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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*
|
||||
<effect> ;
|
||||
|
||||
: (define-word-for-function) ( function interface n -- )
|
||||
|
|
|
|||
|
|
@ -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 <ushort-array>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
[ <no-word-error> 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 <no-word-error> throw-restarts no-word-restarted ]
|
||||
if ;
|
||||
|
||||
: parse-word ( string -- word/number )
|
||||
|
|
|
|||
|
|
@ -14,5 +14,6 @@ IN: curses.tests
|
|||
2000000 sleep
|
||||
] with-curses ;
|
||||
|
||||
[
|
||||
] [ hello-curses ] unit-test
|
||||
curses-ok? [
|
||||
[ ] [ hello-curses ] unit-test
|
||||
] when
|
||||
|
|
|
|||
|
|
@ -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
|
||||
[
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: count-digits ( n -- byte-array )
|
||||
10 <byte-array> [
|
||||
'[ 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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,4 @@
|
|||
USING: project-euler.070 tools.test ;
|
||||
IN: project-euler.070.tests
|
||||
|
||||
[ 8319823 ] [ euler070 ] unit-test
|
||||
|
|
@ -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.
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! NOTE: ±1000 is an arbitrary range
|
||||
: likely-prime-factors ( -- seq )
|
||||
7 10^ sqrt >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
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
USING: project-euler.206 tools.test ;
|
||||
IN: project-euler.206.tests
|
||||
|
||||
[ 1389019170 ] [ euler206 ] unit-test
|
||||
|
|
@ -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.
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! 1020304050607080900 sqrt, rounded up to the nearest 30 ending
|
||||
CONSTANT: lo 1010101030
|
||||
|
||||
! 1929394959697989900 sqrt, rounded down to the nearest 70 ending
|
||||
CONSTANT: hi 1389026570
|
||||
|
||||
: form-fitting? ( n -- ? )
|
||||
number>digits 2 group [ first ] map
|
||||
{ 1 2 3 4 5 6 7 8 9 0 } = ;
|
||||
|
||||
: candidates ( -- seq )
|
||||
lo lo 40 + [ hi 100 <range> ] 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
|
||||
|
|
@ -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.
|
||||
!
|
||||
<PRIVATE
|
||||
|
||||
: round-to-10-decimals ( a -- b ) 1.0e10 * round 1.0e10 / ;
|
||||
! [ see URL for figure ]
|
||||
|
||||
! 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.
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! same as produce, but outputs the sum instead of the sequence of results
|
||||
: produce-sum ( id pred quot -- sum )
|
||||
[ 0 ] 2dip [ [ dip swap ] curry ] [ [ dip + ] curry ] bi* while ; inline
|
||||
|
||||
: x0 ( i -- x0 )
|
||||
number-length dup even?
|
||||
number-length dup even?
|
||||
[ 2 - 2 / 10 swap ^ 7 * ]
|
||||
[ 1 - 2 / 10 swap ^ 2 * ] if ;
|
||||
|
||||
: ⌈a/b⌉ ( a b -- ⌈a/b⌉ )
|
||||
[ 1 - + ] keep /i ;
|
||||
|
||||
|
|
@ -56,38 +71,37 @@ IN: project-euler.255
|
|||
DEFER: iteration#
|
||||
! Gives the number of iterations when xk+1 has the same value for all a<=i<=n
|
||||
:: (iteration#) ( i xi a b -- # )
|
||||
a xi xk+1 dup xi =
|
||||
[ drop i b a - 1 + * ]
|
||||
[ i 1 + swap a b iteration# ] if ;
|
||||
a xi xk+1 dup xi =
|
||||
[ drop i b a - 1 + * ]
|
||||
[ i 1 + swap a b iteration# ] if ;
|
||||
|
||||
! Gives the number of iterations in the general case by breaking into intervals
|
||||
! in which xk+1 is the same.
|
||||
:: iteration# ( i xi a b -- # )
|
||||
a
|
||||
a xi next-multiple
|
||||
[ dup b < ]
|
||||
[
|
||||
a
|
||||
a xi next-multiple
|
||||
[ dup b < ]
|
||||
[
|
||||
! set up the values for the next iteration
|
||||
[ nip [ 1 + ] [ xi + ] bi ] 2keep
|
||||
! set up the arguments for (iteration#)
|
||||
[ i xi ] 2dip (iteration#)
|
||||
] produce-sum
|
||||
[ i xi ] 2dip (iteration#)
|
||||
] produce-sum
|
||||
! deal with the last numbers
|
||||
[ drop b [ i xi ] 2dip (iteration#) ] dip
|
||||
+ ;
|
||||
|
||||
: 10^ ( a -- 10^a ) 10 swap ^ ; inline
|
||||
|
||||
: (euler255) ( a b -- answer )
|
||||
: (euler255) ( a b -- answer )
|
||||
[ 10^ ] bi@ 1 -
|
||||
[ [ drop x0 1 swap ] 2keep iteration# ] 2keep
|
||||
swap - 1 + /f ;
|
||||
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: 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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (c) 2007-2009 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 ;
|
||||
! Copyright (c) 2007-2010 Aaron Schaefer.
|
||||
! 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
|
||||
|
|
@ -19,12 +20,13 @@ 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
|
||||
! 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
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: count-digits ( n -- byte-array )
|
||||
10 <byte-array> [
|
||||
'[ 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 ;
|
||||
|
||||
|
|
@ -83,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 ;
|
||||
|
||||
|
|
@ -107,6 +119,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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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.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
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
Loading…
Reference in New Issue