Merge commit 'erg/master'
Slava Pestov
commit
02fc6cdaed
|
|
@ -0,0 +1,7 @@
|
|||
USING: crypto.sha1 io.files kernel ;
|
||||
IN: benchmark.sha1
|
||||
|
||||
: sha1-primes-list ( -- seq )
|
||||
"extra/math/primes/list/list.factor" resource-path file>sha1 ;
|
||||
|
||||
MAIN: sha1-primes-list
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup channels ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: channels
|
||||
|
||||
HELP: <channel>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup channels channels.remote concurrency.distributed ;
|
||||
USING: help.syntax help.markup channels concurrency.distributed ;
|
||||
IN: channels.remote
|
||||
|
||||
HELP: <remote-channel>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,3 @@
|
|||
USING: io.backend ;
|
||||
|
||||
HOOK: sniff-channel io-backend ( -- channel )
|
||||
|
|
@ -2,8 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
! Wrap a sniffer in a channel
|
||||
USING: kernel channels channels.sniffer concurrency io
|
||||
io.sniffer io.sniffer.bsd io.unix.backend ;
|
||||
USING: kernel channels channels.sniffer.backend concurrency io
|
||||
io.sniffer.backend io.sniffer.bsd io.unix.backend ;
|
||||
IN: channels.sniffer.bsd
|
||||
|
||||
M: unix-io sniff-channel ( -- channel )
|
||||
"/dev/bpf0" "en1" <sniffer-spec> <sniffer> <channel> [
|
||||
|
|
|
|||
|
|
@ -3,11 +3,9 @@
|
|||
!
|
||||
! Wrap a sniffer in a channel
|
||||
USING: kernel channels concurrency io io.backend
|
||||
io.sniffer system vocabs.loader ;
|
||||
io.sniffer io.sniffer.backend system vocabs.loader ;
|
||||
|
||||
: (sniff-channel) ( stream channel -- )
|
||||
4096 pick stream-read-partial over to (sniff-channel) ;
|
||||
|
||||
HOOK: sniff-channel io-backend ( -- channel )
|
||||
|
||||
bsd? [ "channels.sniffer.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
|
||||
USING: help.markup help.syntax coroutines ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: coroutines
|
||||
|
||||
HELP: cocreate
|
||||
{ $values { "quot" "a quotation with stack effect ( value -- )" } { "co" "a coroutine" } }
|
||||
|
|
|
|||
|
|
@ -12,14 +12,11 @@ USING: alien kernel system combinators alien.syntax ;
|
|||
|
||||
IN: cryptlib.libcl
|
||||
|
||||
: load-libcl ( -- )
|
||||
"libcl" {
|
||||
<< "libcl" {
|
||||
{ [ win32? ] [ "cl32.dll" "stdcall" ] }
|
||||
{ [ macosx? ] [ "libcl.dylib" "cdecl" ] }
|
||||
{ [ unix? ] [ "libcl.so" "cdecl" ] }
|
||||
} cond add-library ; parsing
|
||||
|
||||
load-libcl
|
||||
} cond add-library >>
|
||||
|
||||
! ===============================================
|
||||
! Machine-dependant types
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: help.markup help.syntax kernel math sequences quotations
|
||||
crypto.common crypto.md5 ;
|
||||
crypto.common ;
|
||||
IN: crypto.md5
|
||||
|
||||
HELP: stream>md5
|
||||
{ $values { "stream" "a stream" } { "byte-array" "md5 hash" } }
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
USING: definitions help help.markup help.syntax io io.files
|
||||
editors words ;
|
||||
USING: definitions help help.markup help.syntax io io.files editors words ;
|
||||
IN: editors.vim
|
||||
|
||||
ARTICLE: { "vim" "vim" } "Vim support"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! -*-factor-*-
|
||||
|
||||
USING: kernel unix vars mortar slot-accessors
|
||||
USING: kernel unix vars mortar mortar.sugar slot-accessors
|
||||
x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
|
||||
factory.commands factory.load ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel parser io io.files namespaces sequences editors threads vars
|
||||
mortar slot-accessors
|
||||
mortar mortar.sugar slot-accessors
|
||||
x
|
||||
x.widgets.wm.root
|
||||
x.widgets.wm.frame
|
||||
|
|
|
|||
|
|
@ -0,0 +1,14 @@
|
|||
IN: hardware-info.backend
|
||||
|
||||
SYMBOL: os
|
||||
HOOK: cpus os ( -- n )
|
||||
|
||||
HOOK: memory-load os ( -- n )
|
||||
HOOK: physical-mem os ( -- n )
|
||||
HOOK: available-mem os ( -- n )
|
||||
HOOK: total-page-file os ( -- n )
|
||||
HOOK: available-page-file os ( -- n )
|
||||
HOOK: total-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-extended-mem os ( -- n )
|
||||
|
||||
|
|
@ -1,26 +1,15 @@
|
|||
USING: alien.syntax math prettyprint system combinators
|
||||
vocabs.loader ;
|
||||
USING: alien.syntax kernel math prettyprint system
|
||||
combinators vocabs.loader hardware-info.backend ;
|
||||
IN: hardware-info
|
||||
|
||||
SYMBOL: os
|
||||
HOOK: cpus os ( -- n )
|
||||
|
||||
HOOK: memory-load os ( -- n )
|
||||
HOOK: physical-mem os ( -- n )
|
||||
HOOK: available-mem os ( -- n )
|
||||
HOOK: total-page-file os ( -- n )
|
||||
HOOK: available-page-file os ( -- n )
|
||||
HOOK: total-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-mem os ( -- n )
|
||||
HOOK: available-virtual-extended-mem os ( -- n )
|
||||
|
||||
: kb. ( x -- ) 10 2^ /f . ;
|
||||
: megs. ( x -- ) 20 2^ /f . ;
|
||||
: gigs. ( x -- ) 30 2^ /f . ;
|
||||
|
||||
{
|
||||
<< {
|
||||
{ [ windows? ] [ "hardware-info.windows" ] }
|
||||
{ [ linux? ] [ "hardware-info.linux" ] }
|
||||
{ [ macosx? ] [ "hardware-info.macosx" ] }
|
||||
} cond require
|
||||
{ [ t ] [ f ] }
|
||||
} cond [ require ] when* >>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien alien.c-types alien.syntax byte-arrays kernel
|
||||
namespaces sequences unix hardware-info ;
|
||||
namespaces sequences unix hardware-info.backend ;
|
||||
IN: hardware-info.macosx
|
||||
|
||||
TUPLE: macosx ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: alien.c-types hardware-info hardware-info.windows
|
||||
kernel math namespaces windows windows.kernel32 ;
|
||||
kernel math namespaces windows windows.kernel32
|
||||
hardware-info.backend ;
|
||||
IN: hardware-info.windows.ce
|
||||
|
||||
T{ wince } os set-global
|
||||
|
|
@ -29,5 +30,3 @@ M: wince total-virtual-mem ( -- n )
|
|||
|
||||
M: wince available-virtual-mem ( -- n )
|
||||
memory-status MEMORYSTATUS-dwAvailVirtual ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: alien alien.c-types hardware-info hardware-info.windows
|
||||
kernel libc math namespaces
|
||||
kernel libc math namespaces hardware-info.backend
|
||||
windows windows.advapi32 windows.kernel32 ;
|
||||
IN: hardware-info.windows.nt
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: alien alien.c-types kernel libc math namespaces
|
||||
windows windows.kernel32 windows.advapi32 hardware-info
|
||||
words combinators vocabs.loader ;
|
||||
windows windows.kernel32 windows.advapi32
|
||||
words combinators vocabs.loader hardware-info.backend ;
|
||||
IN: hardware-info.windows
|
||||
|
||||
TUPLE: wince ;
|
||||
|
|
@ -70,7 +70,8 @@ M: windows cpus ( -- n )
|
|||
: system-windows-directory ( -- str )
|
||||
\ GetSystemWindowsDirectory get-directory ;
|
||||
|
||||
{
|
||||
<< {
|
||||
{ [ wince? ] [ "hardware-info.windows.ce" ] }
|
||||
{ [ winnt? ] [ "hardware-info.windows.nt" ] }
|
||||
} cond require
|
||||
{ [ t ] [ f ] }
|
||||
} cond [ require ] when* >>
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@ USING: assocs circular combinators continuations hashtables
|
|||
hashtables.private io kernel math
|
||||
namespaces prettyprint quotations sequences splitting
|
||||
state-parser strings ;
|
||||
USING: html.parser ;
|
||||
IN: html.parser.utils
|
||||
|
||||
: string-parse-end?
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax http.basic-authentication crypto.sha2 ;
|
||||
USING: help.markup help.syntax crypto.sha2 ;
|
||||
IN: http.basic-authentication
|
||||
|
||||
HELP: realms
|
||||
{ $description
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Coyright (C) 2007 Adam Wendt
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: id3 help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: id3
|
||||
|
||||
ARTICLE: "id3-tags" "ID3 Tags"
|
||||
"The " { $vocab-link "id3" } " vocabulary is used to read ID3 tags from MP3 audio streams."
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
USING: inverse help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: inverse
|
||||
|
||||
HELP: [undo]
|
||||
{ $values { "quot" "a quotation" } { "undo" "the inverse of the quotation" } }
|
||||
|
|
|
|||
|
|
@ -63,7 +63,9 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
|
|||
{
|
||||
{ [ dup word? not over symbol? or ] [ , ] }
|
||||
{ [ dup explicit-inverse? ] [ , ] }
|
||||
{ [ dup compound? over { if dispatch } member? not and ]
|
||||
! { [ dup compound? over { if dispatch } member? not and ]
|
||||
! [ word-def [ inline-word ] each ] }
|
||||
{ [ dup word? over { if dispatch } member? not and ]
|
||||
[ word-def [ inline-word ] each ] }
|
||||
{ [ drop t ] [ "Quotation is not invertible" throw ] }
|
||||
} cond ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
USING: io.backend kernel system vocabs.loader ;
|
||||
IN: io.sniffer.backend
|
||||
|
||||
SYMBOL: sniffer-type
|
||||
TUPLE: sniffer ;
|
||||
HOOK: <sniffer> io-backend ( obj -- sniffer )
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2007 Elie Chaftari, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax destructors hexdump io
|
||||
io.buffers io.nonblocking io.sniffer io.sockets io.streams.lines
|
||||
io.buffers io.nonblocking io.sockets io.streams.lines
|
||||
io.unix.backend io.unix.files kernel libc locals math qualified
|
||||
sequences ;
|
||||
sequences io.sniffer.backend ;
|
||||
QUALIFIED: unix
|
||||
IN: io.sniffer.bsd
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,17 @@
|
|||
USING: byte-arrays combinators io io.backend
|
||||
io.sockets.headers io.sniffer.backend kernel
|
||||
prettyprint sequences ;
|
||||
IN: io.sniffer.filter.backend
|
||||
|
||||
HOOK: sniffer-loop io-backend ( stream -- )
|
||||
HOOK: packet. io-backend ( string -- )
|
||||
|
||||
: (packet.) ( string -- )
|
||||
dup 14 head >byte-array
|
||||
"--Ethernet Header--" print
|
||||
dup etherneth.
|
||||
dup etherneth-type {
|
||||
! HEX: 800 [ ] ! IP
|
||||
! HEX: 806 [ ] ! ARP
|
||||
[ "Unknown type: " write .h ]
|
||||
} case 2drop ;
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
USING: alien.c-types hexdump io io.backend io.sockets.headers
|
||||
io.sockets.headers.bsd kernel io.sniffer io.sniffer.bsd
|
||||
io.sniffer.filter io.streams.string io.unix.backend math
|
||||
sequences system byte-arrays ;
|
||||
io.streams.string io.unix.backend math
|
||||
sequences system byte-arrays io.sniffer.filter.backend
|
||||
io.sniffer.filter.backend io.sniffer.backend ;
|
||||
IN: io.sniffer.filter.bsd
|
||||
|
||||
! http://www.iana.org/assignments/ethernet-numbers
|
||||
|
|
|
|||
|
|
@ -1,19 +1,8 @@
|
|||
USING: alien.c-types byte-arrays combinators hexdump io
|
||||
io.backend io.streams.string io.sockets.headers kernel math
|
||||
prettyprint io.sniffer sequences system vocabs.loader ;
|
||||
prettyprint io.sniffer sequences system vocabs.loader
|
||||
io.sniffer.filter.backend ;
|
||||
IN: io.sniffer.filter
|
||||
|
||||
HOOK: sniffer-loop io-backend ( stream -- )
|
||||
HOOK: packet. io-backend ( string -- )
|
||||
|
||||
: (packet.) ( string -- )
|
||||
dup 14 head >byte-array
|
||||
"--Ethernet Header--" print
|
||||
dup etherneth.
|
||||
dup etherneth-type {
|
||||
! HEX: 800 [ ] ! IP
|
||||
! HEX: 806 [ ] ! ARP
|
||||
[ "Unknown type: " write .h ]
|
||||
} case 2drop ;
|
||||
|
||||
bsd? [ "io.sniffer.filter.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,10 +1,4 @@
|
|||
USING: io.backend kernel system vocabs.loader ;
|
||||
IN: io.sniffer
|
||||
|
||||
SYMBOL: sniffer-type
|
||||
|
||||
TUPLE: sniffer ;
|
||||
|
||||
HOOK: <sniffer> io-backend ( obj -- sniffer )
|
||||
|
||||
bsd? [ "io.sniffer.bsd" require ] when
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: kernel opengl arrays sequences jamshred jamshred.tunnel
|
||||
USING: kernel opengl arrays sequences jamshred.tunnel
|
||||
jamshred.player math.vectors ;
|
||||
IN: jamshred.game
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: colors jamshred.game jamshred.oint jamshred.tunnel kernel
|
||||
USING: colors jamshred.oint jamshred.tunnel kernel
|
||||
math math.constants sequences ;
|
||||
IN: jamshred.player
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax json.reader ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: json.reader
|
||||
|
||||
HELP: json> "( string -- object )"
|
||||
{ $values { "string" "a string in JSON format" } { "object" "yhe object deserialized from the JSON string" } }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax json.writer ;
|
||||
USING: help.markup help.syntax ;
|
||||
IN: json.writer
|
||||
|
||||
HELP: >json "( obj -- string )"
|
||||
{ $values { "obj" "an object" } { "string" "the object converted to JSON format" } }
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ GENERIC: json-print ( obj -- )
|
|||
[ json-print ] string-out ;
|
||||
|
||||
M: f json-print ( f -- )
|
||||
"false" write ;
|
||||
drop "false" write ;
|
||||
|
||||
M: string json-print ( obj -- )
|
||||
CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ USING: kernel parser namespaces io prettyprint math arrays sequences
|
|||
|
||||
IN: lisp.listener
|
||||
|
||||
: parse-stdio ( -- quot/f ) stdio get parse-interactive ;
|
||||
: parse-stdio ( -- quot/f ) stdio get read-quot ;
|
||||
|
||||
: stuff? ( -- ? ) datastack length 0 > ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,14 +4,11 @@
|
|||
USING: alien alien.c-types alien.syntax combinators kernel math system ;
|
||||
IN: mad
|
||||
|
||||
: load-mad-library ( -- )
|
||||
"mad" {
|
||||
<< "mad" {
|
||||
{ [ macosx? ] [ "libmad.0.dylib" ] }
|
||||
{ [ unix? ] [ "libmad.so" ] }
|
||||
{ [ windows? ] [ "mad.dll" ] }
|
||||
} cond "cdecl" add-library ; parsing
|
||||
|
||||
load-mad-library
|
||||
} cond "cdecl" add-library >>
|
||||
|
||||
LIBRARY: mad
|
||||
|
||||
|
|
|
|||
|
|
@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
|
|||
dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
|
||||
|
||||
: factor-2s ( n -- r s )
|
||||
#! factor an even number into s * 2 ^ r
|
||||
dup even? over 0 > and [
|
||||
positive-even-expected construct-boa throw
|
||||
] unless 0 swap (factor-2s) ;
|
||||
#! factor an integer into s * 2^r
|
||||
0 swap (factor-2s) ;
|
||||
|
||||
:: (miller-rabin) | n prime?! |
|
||||
n 1- factor-2s s set r set
|
||||
|
|
|
|||
|
|
@ -1,20 +1,23 @@
|
|||
USING: help.markup help.syntax ;
|
||||
USING: help.markup help.syntax math sequences ;
|
||||
IN: math.primes.factors
|
||||
|
||||
{ factors count-factors unique-factors } related-words
|
||||
{ factors group-factors unique-factors } related-words
|
||||
|
||||
HELP: factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ;
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
|
||||
{ $examples { $example "300 factors ." "{ 2 2 3 5 5 }" } } ;
|
||||
|
||||
HELP: count-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ;
|
||||
HELP: group-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
|
||||
{ $examples { $example "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
|
||||
|
||||
HELP: unique-factors
|
||||
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
|
||||
{ $description { "Return an ordered list of unique prime factors." } } ;
|
||||
{ $values { "n" "a positive integer" } { "seq" sequence } }
|
||||
{ $description { "Return an ordered list of a number's unique prime factors." } }
|
||||
{ $examples { $example "300 unique-factors ." "{ 2 3 5 }" } } ;
|
||||
|
||||
HELP: totient
|
||||
{ $values { "n" "a positive integer" } { "t" "an integer" } }
|
||||
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ;
|
||||
{ $values { "n" "a positive integer" } { "t" integer } }
|
||||
{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: math.primes.factors tools.test ;
|
||||
|
||||
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
|
||||
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 count-factors ] unit-test
|
||||
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
|
||||
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
|
||||
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
|
||||
|
|
|
|||
|
|
@ -6,36 +6,36 @@ IN: math.primes.factors
|
|||
<PRIVATE
|
||||
|
||||
: (factor) ( n d -- n' )
|
||||
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
|
||||
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
|
||||
|
||||
: (count) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
|
||||
|
||||
: (unique) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ first , ] if ;
|
||||
[ (factor) ] { } make
|
||||
dup empty? [ drop ] [ first , ] if ;
|
||||
|
||||
: (factors) ( quot list n -- )
|
||||
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
|
||||
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
|
||||
|
||||
: (decompose) ( n quot -- seq )
|
||||
[ lprimes rot (factors) ] { } make ;
|
||||
[ lprimes rot (factors) ] { } make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: factors ( n -- seq )
|
||||
[ (factor) ] (decompose) ; foldable
|
||||
[ (factor) ] (decompose) ; foldable
|
||||
|
||||
: count-factors ( n -- seq )
|
||||
[ (count) ] (decompose) ; foldable
|
||||
: group-factors ( n -- seq )
|
||||
[ (count) ] (decompose) ; foldable
|
||||
|
||||
: unique-factors ( n -- seq )
|
||||
[ (unique) ] (decompose) ; foldable
|
||||
[ (unique) ] (decompose) ; foldable
|
||||
|
||||
: totient ( n -- t )
|
||||
dup 2 < [
|
||||
drop 0
|
||||
] [
|
||||
[ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep *
|
||||
] if ; foldable
|
||||
dup 2 < [
|
||||
drop 0
|
||||
] [
|
||||
dup unique-factors dup 1 [ 1- * ] reduce swap product / *
|
||||
] if ; foldable
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ over object-class class-methods 1 head* assoc-stack call ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: new* ( class -- object ) <<- create ;
|
||||
! : new* ( class -- object ) <<- create ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -136,13 +136,20 @@ IN: slot-accessors
|
|||
|
||||
IN: mortar
|
||||
|
||||
! : generate-slot-getter ( name -- )
|
||||
! "$" over append "slot-accessors" create swap [ slot-value ] curry
|
||||
! define-compound ;
|
||||
|
||||
: generate-slot-getter ( name -- )
|
||||
"$" over append "slot-accessors" create swap [ slot-value ] curry
|
||||
define-compound ;
|
||||
"$" over append "slot-accessors" create swap [ slot-value ] curry define ;
|
||||
|
||||
! : generate-slot-setter ( name -- )
|
||||
! ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
|
||||
! define-compound ;
|
||||
|
||||
: generate-slot-setter ( name -- )
|
||||
">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
|
||||
define-compound ;
|
||||
define ;
|
||||
|
||||
: generate-slot-accessors ( name -- )
|
||||
dup
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
|
||||
USING: mortar ;
|
||||
|
||||
IN: mortar.sugar
|
||||
|
||||
: new* ( class -- object ) <<- create ;
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup parser-combinators
|
||||
parser-combinators.simple ;
|
||||
USING: help.syntax help.markup parser-combinators ;
|
||||
IN: parser-combinators.simple
|
||||
|
||||
HELP: 'digit'
|
||||
{ $values
|
||||
|
|
|
|||
|
|
@ -24,14 +24,18 @@ IN: project-euler.006
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: sum-of-squares ( seq -- n )
|
||||
0 [ sq + ] reduce ;
|
||||
|
||||
: square-of-sums ( seq -- n )
|
||||
0 [ + ] reduce sq ;
|
||||
: square-of-sum ( seq -- n )
|
||||
sum sq ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler006 ( -- answer )
|
||||
1 100 [a,b] dup sum-of-squares swap square-of-sums - abs ;
|
||||
1 100 [a,b] dup sum-of-squares swap square-of-sum - abs ;
|
||||
|
||||
! [ euler006 ] 100 ave-time
|
||||
! 0 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -0,0 +1,71 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.primes math.ranges sequences ;
|
||||
IN: project-euler.026
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=26
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! A unit fraction contains 1 in the numerator. The decimal representation of
|
||||
! the unit fractions with denominators 2 to 10 are given:
|
||||
|
||||
! 1/2 = 0.5
|
||||
! 1/3 = 0.(3)
|
||||
! 1/4 = 0.25
|
||||
! 1/5 = 0.2
|
||||
! 1/6 = 0.1(6)
|
||||
! 1/7 = 0.(142857)
|
||||
! 1/8 = 0.125
|
||||
! 1/9 = 0.(1)
|
||||
! 1/10 = 0.1
|
||||
|
||||
! Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be
|
||||
! seen that 1/7 has a 6-digit recurring cycle.
|
||||
|
||||
! Find the value of d < 1000 for which 1/d contains the longest recurring cycle
|
||||
! in its decimal fraction part.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: source-026 ( -- seq )
|
||||
1 1000 (a,b) [ prime? ] subset [ 1 swap / ] map ;
|
||||
|
||||
: (mult-order) ( n a m -- k )
|
||||
3dup ^ swap mod 1 = [ 2nip ] [ 1+ (mult-order) ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: coprime? ( m n -- ? )
|
||||
gcd 1 = nip ;
|
||||
|
||||
: recurring-period? ( a/b -- ? )
|
||||
denominator 10 coprime? ;
|
||||
|
||||
! Multiplicative order a.k.a. modulo order
|
||||
: mult-order ( a n -- k )
|
||||
swap 1 (mult-order) ;
|
||||
|
||||
: period-length ( a/b -- n )
|
||||
dup recurring-period? [ denominator 10 swap mult-order ] [ drop 0 ] if ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: max-period ( seq -- elt n )
|
||||
dup [ period-length ] map dup supremum
|
||||
over index [ swap nth ] curry 2apply ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler026 ( -- answer )
|
||||
source-026 max-period drop denominator ;
|
||||
|
||||
! [ euler026 ] 100 ave-time
|
||||
! 724 ms run / 7 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler026
|
||||
|
|
@ -34,9 +34,6 @@ IN: project-euler.common
|
|||
: propagate ( bottom top -- newtop )
|
||||
[ over 1 tail rot first2 max rot + ] map nip ;
|
||||
|
||||
: reduce-2s ( n -- r s )
|
||||
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
|
||||
|
||||
: shift-3rd ( seq obj obj -- seq obj obj )
|
||||
rot 1 tail -rot ;
|
||||
|
||||
|
|
@ -88,11 +85,11 @@ PRIVATE>
|
|||
|
||||
! The divisor function, counts the number of divisors
|
||||
: tau ( m -- n )
|
||||
count-factors flip second 1 [ 1+ * ] reduce ;
|
||||
group-factors flip second 1 [ 1+ * ] reduce ;
|
||||
|
||||
! Optimized brute-force, is often faster than prime factorization
|
||||
: tau* ( m -- n )
|
||||
reduce-2s [ perfect-square? -1 0 ? ] keep
|
||||
factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
|
||||
dup sqrt >fixnum [1,b] [
|
||||
dupd mod zero? [ >r 2 + r> ] when
|
||||
dupd mod zero? [ [ 2 + ] dip ] when
|
||||
] each drop * ;
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
|
|||
project-euler.013 project-euler.014 project-euler.015 project-euler.016
|
||||
project-euler.017 project-euler.018 project-euler.019 project-euler.020
|
||||
project-euler.021 project-euler.022 project-euler.023 project-euler.024
|
||||
project-euler.025 project-euler.067 project-euler.134 project-euler.169
|
||||
project-euler.173 project-euler.175 ;
|
||||
project-euler.025 project-euler.026 project-euler.067 project-euler.134
|
||||
project-euler.169 project-euler.173 project-euler.175 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
|
||||
USING: kernel namespaces arrays x11.xlib mortar slot-accessors x x.font ;
|
||||
USING: kernel namespaces arrays x11.xlib mortar mortar.sugar
|
||||
slot-accessors x x.font ;
|
||||
|
||||
IN: x.gc
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel arrays math.vectors mortar x.gc slot-accessors geom.pos ;
|
||||
USING: kernel arrays math.vectors mortar mortar.sugar x.gc slot-accessors geom.pos ;
|
||||
|
||||
IN: x.pen
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators math x11.xlib
|
||||
mortar slot-accessors x.gc x.widgets.label ;
|
||||
mortar mortar.sugar slot-accessors x.gc x.widgets.label ;
|
||||
|
||||
IN: x.widgets.button
|
||||
|
||||
|
|
@ -11,7 +11,7 @@ SYMBOL: <button>
|
|||
{ "action-1" "action-2" "action-3" } accessors
|
||||
define-simple-class
|
||||
|
||||
<button> "create" ( <button> -- button ) [
|
||||
<button> "create" !( <button> -- button ) [
|
||||
new-empty
|
||||
<gc> new* >>gc ExposureMask ButtonPressMask bitor >>mask <- init-widget
|
||||
] add-class-method
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel strings arrays sequences sequences.lib math x11.xlib
|
||||
mortar slot-accessors x x.pen x.widgets ;
|
||||
mortar mortar.sugar slot-accessors x x.pen x.widgets ;
|
||||
|
||||
IN: x.widgets.keymenu
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel x11.xlib mortar slot-accessors x.gc x.widgets ;
|
||||
USING: kernel x11.xlib mortar mortar.sugar slot-accessors x.gc x.widgets ;
|
||||
|
||||
IN: x.widgets.label
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
|
||||
mortar slot-accessors x x.gc x.widgets.wm.frame.drag ;
|
||||
mortar mortar.sugar slot-accessors x x.gc x.widgets.wm.frame.drag ;
|
||||
|
||||
IN: x.widgets.wm.frame.drag.move
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel combinators namespaces math.vectors x11.xlib x11.constants
|
||||
mortar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
|
||||
mortar mortar.sugar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
|
||||
|
||||
IN: x.widgets.wm.frame.drag.size
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
USING: kernel io combinators namespaces quotations arrays sequences
|
||||
math math.vectors
|
||||
x11.xlib x11.constants
|
||||
mortar slot-accessors
|
||||
mortar mortar.sugar slot-accessors
|
||||
geom.rect
|
||||
x x.gc x.widgets
|
||||
x.widgets.button
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
|
||||
USING: kernel x11.constants mortar slot-accessors x.widgets.keymenu ;
|
||||
USING: kernel x11.constants mortar mortar.sugar slot-accessors x.widgets.keymenu ;
|
||||
|
||||
IN: x.widgets.wm.menu
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
USING: xml-rpc help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: xml-rpc
|
||||
|
||||
HELP: send-rpc
|
||||
{ $values { "rpc" "an RPC data type" } { "xml" "an XML document" } }
|
||||
|
|
|
|||
Loading…
Reference in New Issue