steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-12-26 17:14:07 -06:00
parent f9dacfb16b ab6e3e2c3f
commit 6cfb951d82
18 changed files with 116 additions and 6528 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/bit-arrays/bit-arrays-tests.factor
View File

@ -76,3 +76,5 @@ IN: bit-arrays.tests
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
} bit-array>integer ] unit-test
[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test

2
basis/bit-arrays/bit-arrays.factor
View File

@ -25,7 +25,7 @@ TUPLE: bit-array
: (set-bits) ( bit-array n -- )
[ [ length bits>cells ] keep ] dip swap underlying>>
'[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
'[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
PRIVATE>

12
basis/math/miller-rabin/miller-rabin.factor
View File

@ -4,9 +4,9 @@ USING: combinators io locals kernel math math.functions
math.ranges namespaces random sequences hashtables sets ;
IN: math.miller-rabin
: >even ( n -- int ) dup even? [ 1- ] unless ; foldable
<PRIVATE
: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
TUPLE: positive-even-expected n ;
@ -28,6 +28,10 @@ TUPLE: positive-even-expected n ;
] unless drop
] each prime? ] ;
PRIVATE>
: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
: miller-rabin* ( n numtrials -- ? )
over {
{ [ dup 1 <= ] [ 3drop f ] }
@ -46,11 +50,15 @@ TUPLE: positive-even-expected n ;
ERROR: no-relative-prime n ;
<PRIVATE
: (find-relative-prime) ( n guess -- p )
over 1 <= [ over no-relative-prime ] when
dup 1 <= [ drop 3 ] when
2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
PRIVATE>
: find-relative-prime* ( n guess -- p )
#! find a prime relative to n with initial guess
>odd (find-relative-prime) ;

2
extra/4DNav/4DNav.factor
View File

@ -293,7 +293,7 @@ VAR: present-space
closed-quot <roll-button> { 0 0 } >>align ;
: <list-runner> ( -- gadget )
"extra/4DNav"
"resource:extra/4DNav"
<pile> 1 >>fill
over dup directory-files
[ ".xml" tail? ] filter

4
extra/4DNav/file-chooser/file-chooser.factor
View File

@ -4,6 +4,9 @@ USING:
kernel
io.files
io.backend
io.directories
io.files.info
io.pathnames
sequences
models
strings
@ -23,7 +26,6 @@ prettyprint
combinators
rewrite-closures
accessors
namespaces.lib
values
tools.walker
fry

6
extra/math/erato/erato-docs.factor
View File

@ -1,6 +0,0 @@
USING: help.markup help.syntax ;
IN: math.erato
HELP: lerato
{ $values { "n" "a positive number" } { "lazy-list" "a lazy prime numbers generator" } }
{ $description "Builds a lazy list containing the prime numbers between 2 and " { $snippet "n" } " (inclusive)." } ;

6
extra/math/erato/erato-tests.factor
View File

@ -1,6 +0,0 @@
! Copyright (c) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: lists.lazy math.erato tools.test ;
IN: math.erato.tests
[ { 2 3 5 7 11 13 17 19 } ] [ 20 lerato list>array ] unit-test

43
extra/math/erato/erato.factor
View File

@ -1,43 +0,0 @@
! Copyright (c) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors bit-arrays fry kernel lists.lazy math math.functions
math.primes.list math.ranges sequences ;
IN: math.erato
<PRIVATE
TUPLE: erato limit bits latest ;
: ind ( n -- i )
2/ 1- ; inline
: is-prime ( n limit -- bool )
[ ind ] [ bits>> ] bi* nth ; inline
: indices ( n erato -- range )
limit>> ind over 3 * ind spin <range> ;
: mark-multiples ( n erato -- )
2dup [ sq ] [ limit>> ] bi* <= [
[ indices ] keep bits>> '[ _ f -rot set-nth ] each
] [ 2drop ] if ;
: <erato> ( n -- erato )
dup ind 1+ <bit-array> dup set-bits 1 erato boa ;
: next-prime ( erato -- prime/f )
[ 2 + ] change-latest [ latest>> ] keep
2dup limit>> <= [
2dup is-prime [ dupd mark-multiples ] [ nip next-prime ] if
] [
2drop f
] if ;
PRIVATE>
: lerato ( n -- lazy-list )
dup 1000003 < [
0 primes-under-million seq>list swap '[ _ <= ] lwhile
] [
<erato> 2 [ drop next-prime ] with lfrom-by [ ] lwhile
] if ;

12
extra/math/primes/erato/erato-docs.factor Normal file
View File

@ -0,0 +1,12 @@
USING: help.markup help.syntax ;
IN: math.primes.erato
HELP: sieve
{ $values { "n" "the greatest odd number to consider" } { "arr" "a bit array" } }
{ $description "Return a bit array containing a primality bit for every odd number between 3 and " { $snippet "n" } " (inclusive). " { $snippet ">index" } " can be used to retrieve the index of an odd number to be tested." } ;
HELP: >index
{ $values { "n" "an odd number" } { "i" "the corresponding index" } }
{ $description "Retrieve the index corresponding to the odd number on the stack." } ;
{ sieve >index } related-words

3
extra/math/primes/erato/erato-tests.factor Normal file
View File

@ -0,0 +1,3 @@
USING: bit-arrays math.primes.erato tools.test ;
[ ?{ t t t f t t f t t f t f f t } ] [ 29 sieve ] unit-test

23
extra/math/primes/erato/erato.factor Normal file
View File

@ -0,0 +1,23 @@
USING: bit-arrays kernel math math.functions math.ranges sequences ;
IN: math.primes.erato
: >index ( n -- i )
3 - 2 /i ; inline
: index> ( i -- n )
2 * 3 + ; inline
: mark-multiples ( i arr -- )
[ dup index> [ + ] keep ] dip
[ length 1 - swap <range> f swap ] keep
[ set-nth ] curry with each ;
: maybe-mark-multiples ( i arr -- )
2dup nth [ mark-multiples ] [ 2drop ] if ;
: init-sieve ( n -- arr )
>index 1 + <bit-array> dup set-bits ;
: sieve ( n -- arr )
[ init-sieve ] [ sqrt >index [0,b] ] bi
over [ maybe-mark-multiples ] curry each ; foldable

6421
extra/math/primes/list/list.factor
View File

File diff suppressed because it is too large Load Diff

2
extra/math/primes/primes-docs.factor
View File

@ -4,7 +4,7 @@ IN: math.primes
{ next-prime prime? } related-words
HELP: next-prime
{ $values { "n" "a positive integer" } { "p" "a prime number" } }
{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } }
{ $description "Return the next prime number greater than " { $snippet "n" } "." } ;
HELP: prime?

4
extra/math/primes/primes-tests.factor
View File

@ -8,3 +8,7 @@ USING: arrays math.primes tools.test lists.lazy ;
{ { 999983 1000003 } } [ 2 999982 lprimes-from ltake list>array ] unit-test
{ { 2 3 5 7 } } [ 10 primes-upto >array ] unit-test
{ { 999983 1000003 } } [ 999982 1000010 primes-between >array ] unit-test
{ { 4999963 4999999 5000011 5000077 5000081 } }
[ 4999962 5000082 primes-between >array ]
unit-test

46
extra/math/primes/primes.factor
View File

@ -1,47 +1,39 @@
! Copyright (C) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: binary-search combinators kernel lists.lazy math math.functions
math.miller-rabin math.primes.list sequences ;
math.miller-rabin math.primes.erato math.ranges sequences ;
IN: math.primes
<PRIVATE
: find-prime-miller-rabin ( n -- p )
dup miller-rabin [ 2 + find-prime-miller-rabin ] unless ; foldable
: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
: really-prime? ( n -- ? )
dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
PRIVATE>
: next-prime ( n -- p )
dup 999983 < [
primes-under-million [ natural-search drop 1+ ] keep nth
] [
next-odd find-prime-miller-rabin
] if ; foldable
: prime? ( n -- ? )
dup 1000000 < [
dup primes-under-million natural-search nip =
] [
miller-rabin
] if ; foldable
{
{ [ dup 2 < ] [ drop f ] }
{ [ dup even? ] [ 2 = ] }
[ really-prime? ]
} cond ; foldable
: lprimes ( -- list )
0 primes-under-million seq>list
1000003 [ 2 + find-prime-miller-rabin ] lfrom-by
lappend ;
: next-prime ( n -- p )
next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
: lprimes ( -- list ) 2 [ next-prime ] lfrom-by ;
: lprimes-from ( n -- list )
dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ;
: primes-upto ( n -- seq )
{
{ [ dup 2 < ] [ drop { } ] }
{ [ dup 1000003 < ] [
primes-under-million [ natural-search drop 1+ 0 swap ] keep <slice>
] }
[ primes-under-million 1000003 lprimes-from
rot [ <= ] curry lwhile list>array append ]
} cond ; foldable
dup 2 < [
drop V{ }
] [
3 swap 2 <range> [ prime? ] filter 2 prefix
] if ; foldable
: primes-between ( low high -- seq )
primes-upto [ 1- next-prime ] dip

7
extra/project-euler/010/010.factor
View File

@ -19,10 +19,7 @@ IN: project-euler.010
: euler010 ( -- answer )
2000000 primes-upto sum ;
! [ euler010 ] time
! 266425 ms run / 10001 ms GC time
! TODO: this takes well over one minute now that they changed the problem to
! two million instead of one. the primes vocab could use some improvements
! [ euler010 ] 100 ave-time
! 15 ms ave run time - 0.41 SD (100 trials)
MAIN: euler010

41
misc/fuel/fuel-debug-uses.el
View File

@ -32,12 +32,12 @@
(fuel-font-lock--defface fuel-font-lock-debug-uses-header
'bold fuel-debug "headers in Uses buffers")
(fuel-font-lock--defface fuel-font-lock-debug-uses-prompt
'italic fuel-debug "prompts in Uses buffers")
;;; Utility functions:
(defsubst fuel-debug--at-eou-p ()
(looking-at ".*\\_<;\\_>"))
(defun fuel-debug--file-lines (file)
(when (file-readable-p file)
(with-current-buffer (find-file-noselect file)
@ -46,19 +46,17 @@
(let ((lines) (in-usings))
(while (not (eobp))
(when (looking-at "^USING: ") (setq in-usings t))
(unless in-usings
(let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
(unless (or (empty-string-p line)
(fuel--string-prefix-p "! " line))
(push line lines))))
(when (and in-usings (fuel-debug--at-eou-p)) (setq in-usings nil))
(when in-usings (setq line (concat "! " line)))
(push line lines))
(when (and in-usings (looking-at ".*\\_<;\\_>")) (setq in-usings nil))
(forward-line))
(reverse lines))))))
(defun fuel-debug--highlight-names (names ref face)
(dolist (n names)
(when (not (member n ref))
(put-text-property 0 (length n) 'face face n))))
(put-text-property 0 (length n) 'font-lock-face face n))))
(defun fuel-debug--uses-new-uses (file uses)
(pop-to-buffer (find-file-noselect file))
@ -72,7 +70,7 @@
(open-line 2)
(insert "USING: "))
(let ((start (point)))
(insert (mapconcat 'identity uses " ") " ;")
(insert (mapconcat 'substring-no-properties uses " ") " ;")
(fill-region start (point) nil)))
(defun fuel-debug--uses-filter (restarts)
@ -186,7 +184,7 @@
(with-current-buffer (fuel-debug--uses-buffer)
(insert "\nDone!")
(fuel-debug--uses-clean)
(fuel-popup--quit)))))
(bury-buffer)))))
(defun fuel-debug--uses-restart (n)
(when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
@ -210,6 +208,25 @@
(define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
map))
(defconst fuel-debug--uses-header-regex
(format "^%s.*$" (regexp-opt '("Infering USING: stanza for "
"Current USING: is already fine!"
"Current vocabulary list:"
"Correct vocabulary list:"
"Sorry, couldn't infer the vocabulary list."
"Done!"))))
(defconst fuel-debug--uses-prompt-regex
(format "^%s" (regexp-opt '("Asking Factor. Please, wait ..."
"Please, type the number of the desired vocabulary:"
"Type 'y' to update your USING: to the new one."))))
(defconst fuel-debug--uses-font-lock-keywords
`((,fuel-debug--uses-header-regex . 'fuel-font-lock-debug-uses-header)
(,fuel-debug--uses-prompt-regex . 'fuel-font-lock-debug-uses-prompt)
(,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
(2 'fuel-font-lock-debug-restart-name))))
(defun fuel-debug-uses-mode ()
"A major mode for displaying Factor's USING: inference results."
(interactive)
@ -217,6 +234,8 @@
(buffer-disable-undo)
(setq major-mode 'fuel-debug-uses-mode)
(setq mode-name "Fuel Uses:")
(set (make-local-variable 'font-lock-defaults)
'(fuel-debug--uses-font-lock-keywords t nil nil nil))
(use-local-map fuel-debug-uses-mode-map))

4
misc/fuel/fuel-syntax.el
View File

@ -318,9 +318,7 @@
(defun fuel-syntax--find-usings ()
(save-excursion
(let ((usings)
(in (fuel-syntax--current-vocab)))
(when in (setq usings (list in)))
(let ((usings))
(goto-char (point-max))
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
(dolist (u (split-string (match-string-no-properties 1) nil t))