Merge branch 'master' of git://factorcode.org/git/factor
Aaron Schaefer
commit
6858b29796
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators io locals kernel math math.functions
|
||||
math.ranges namespaces random sequences hashtables sets ;
|
||||
USING: combinators kernel locals math math.functions math.ranges
|
||||
random sequences 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,12 +28,16 @@ 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 ] }
|
||||
{ [ dup 2 = ] [ 3drop t ] }
|
||||
{ [ dup even? ] [ 3drop f ] }
|
||||
[ [ drop (miller-rabin) ] with-scope ]
|
||||
[ drop (miller-rabin) ]
|
||||
} cond ;
|
||||
|
||||
: miller-rabin ( n -- ? ) 10 miller-rabin* ;
|
||||
|
|
@ -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) ;
|
||||
|
|
|
|||
|
|
@ -65,8 +65,15 @@ HELP: home
|
|||
{ $values { "dir" string } }
|
||||
{ $description "Outputs the user's home directory." } ;
|
||||
|
||||
ARTICLE: "pathname-normalization" "Pathname normalization"
|
||||
"Words that take a pathname should normalize the pathname by calling " { $link normalize-path } ".When normalizing a pathname, the input pathname is either absolute or relative to the " { $link current-directory } ". If absolute, such as the root directories " { $snippet "/" } " or " { $snippet "c:\\" } ", the pathname is left alone, while if relative, the current directory is prepended to the pathname. If a pathname begins with the magic string " { $snippet "resource:" } ", this string is replaced with the Factor directory. On Windows, all pathnames, absolute and relative, are converted to Unicode pathamess." ;
|
||||
|
||||
ARTICLE: "io.pathnames" "Pathname manipulation"
|
||||
{ $subsection "pathname-normalization" }
|
||||
"Literal pathnames:"
|
||||
{ $subsection POSTPONE: P" }
|
||||
"Pathname manipulation:"
|
||||
{ $subsection normalize-path }
|
||||
{ $subsection parent-directory }
|
||||
{ $subsection file-name }
|
||||
{ $subsection last-path-separator }
|
||||
|
|
|
|||
|
|
@ -828,7 +828,7 @@ PRIVATE>
|
|||
|
||||
: supremum ( seq -- n ) dup first [ max ] reduce ;
|
||||
|
||||
: sigma ( seq quot -- n ) [ + ] compose 0 swap reduce ; inline
|
||||
: sigma ( seq quot -- n ) 0 -rot [ rot slip + ] curry each ; inline
|
||||
|
||||
: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,13 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: binary-search math.primes.list math.ranges sequences
|
||||
USING: binary-search kernel math.primes.list math.ranges sequences
|
||||
prettyprint ;
|
||||
IN: benchmark.binary-search
|
||||
|
||||
: binary-search-benchmark ( -- )
|
||||
1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ;
|
||||
|
||||
! Force computation of the primes list before benchmarking the binary search
|
||||
primes-under-million drop
|
||||
|
||||
MAIN: binary-search-benchmark
|
||||
|
|
|
|||
|
|
@ -99,9 +99,7 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
clone fuel-eval-result set-global ; inline
|
||||
|
||||
: fuel-retort ( -- )
|
||||
error get
|
||||
fuel-eval-result get-global
|
||||
fuel-eval-output get-global
|
||||
error get fuel-eval-result get-global fuel-eval-output get-global
|
||||
3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
|
||||
|
||||
: fuel-forget-error ( -- ) f error set-global ; inline
|
||||
|
|
|
|||
|
|
@ -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)." } ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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 -- )
|
||||
[ index> [ sq >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
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,50 +1,38 @@
|
|||
! 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 ;
|
||||
USING: combinators kernel lists.lazy math math.functions
|
||||
math.miller-rabin math.order 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
|
||||
|
||||
: primes-between ( low high -- seq )
|
||||
primes-upto [ 1- next-prime ] dip
|
||||
[ natural-search drop ] [ length ] [ ] tri <slice> ; foldable
|
||||
[ dup 3 max dup even? [ 1 + ] when ] dip
|
||||
2 <range> [ prime? ] filter
|
||||
swap 3 < [ 2 prefix ] when ;
|
||||
|
||||
: primes-upto ( n -- seq ) 2 swap primes-between ;
|
||||
|
||||
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -0,0 +1,43 @@
|
|||
! Copyright (c) 2008 Samuel Tardieu
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.parser sequences ;
|
||||
IN: project-euler.057
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=57
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! It is possible to show that the square root of two can be expressed
|
||||
! as an infinite continued fraction.
|
||||
|
||||
! √ 2 = 1 + 1/(2 + 1/(2 + 1/(2 + ... ))) = 1.414213...
|
||||
|
||||
! By expanding this for the first four iterations, we get:
|
||||
|
||||
! 1 + 1/2 = 3/2 = 1.5
|
||||
! 1 + 1/(2 + 1/2) = 7/5 = 1.4
|
||||
! 1 + 1/(2 + 1/(2 + 1/2)) = 17/12 = 1.41666...
|
||||
! 1 + 1/(2 + 1/(2 + 1/(2 + 1/2))) = 41/29 = 1.41379...
|
||||
|
||||
! The next three expansions are 99/70, 239/169, and 577/408, but the
|
||||
! eighth expansion, 1393/985, is the first example where the number of
|
||||
! digits in the numerator exceeds the number of digits in the
|
||||
! denominator.
|
||||
|
||||
! In the first one-thousand expansions, how many fractions contain a
|
||||
! numerator with more digits than denominator?
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: longer-numerator? ( seq -- ? )
|
||||
>fraction [ number>string length ] bi@ > ; inline
|
||||
|
||||
: euler057 ( -- answer )
|
||||
0 1000 [ drop 2 + recip dup 1+ longer-numerator? ] count nip ;
|
||||
|
||||
! [ euler057 ] time
|
||||
! 3.375118 seconds
|
||||
|
||||
MAIN: euler057
|
||||
|
|
@ -15,13 +15,13 @@ USING: definitions io io.files io.pathnames kernel math math.parser
|
|||
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.052 project-euler.053 project-euler.055 project-euler.056
|
||||
project-euler.059 project-euler.067 project-euler.071 project-euler.073
|
||||
project-euler.075 project-euler.076 project-euler.079 project-euler.092
|
||||
project-euler.097 project-euler.099 project-euler.100 project-euler.116
|
||||
project-euler.117 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.190 project-euler.203
|
||||
project-euler.215 ;
|
||||
project-euler.057 project-euler.059 project-euler.067 project-euler.071
|
||||
project-euler.073 project-euler.075 project-euler.076 project-euler.079
|
||||
project-euler.092 project-euler.097 project-euler.099 project-euler.100
|
||||
project-euler.116 project-euler.117 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.190
|
||||
project-euler.203 project-euler.215 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
|
@ -36,6 +37,7 @@
|
|||
(defvar fuel-autodoc--font-lock-buffer
|
||||
(let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
|
||||
(set-buffer buffer)
|
||||
(set-syntax-table fuel-syntax--syntax-table)
|
||||
(fuel-font-lock--font-lock-setup)
|
||||
buffer))
|
||||
|
||||
|
|
@ -51,8 +53,8 @@
|
|||
(fuel-log--inhibit-p t))
|
||||
(when word
|
||||
(let* ((cmd (if (fuel-syntax--in-using)
|
||||
`(:fuel* (,word fuel-vocab-summary) t t)
|
||||
`(:fuel* (((:quote ,word) synopsis :get)) t)))
|
||||
`(:fuel* (,word fuel-vocab-summary) :in t)
|
||||
`(:fuel* (((:quote ,word) synopsis :get)) :in)))
|
||||
(ret (fuel-eval--send/wait cmd 20))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
(let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
|
||||
(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)
|
||||
|
|
@ -184,9 +182,9 @@
|
|||
(fuel-debug--uses-new-uses fuel-debug--uses-file fuel-debug--uses)
|
||||
(message "USING: updated!")
|
||||
(with-current-buffer (fuel-debug--uses-buffer)
|
||||
(insert "\n Done!")
|
||||
(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))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -67,7 +67,7 @@
|
|||
(cons :array (mapcar 'factor lst)))
|
||||
|
||||
(defsubst factor--fuel-in (in)
|
||||
(cond ((null in) :in)
|
||||
(cond ((or (eq in :in) (null in)) :in)
|
||||
((eq in 'f) 'f)
|
||||
((eq in 't) "fuel-scratchpad")
|
||||
((stringp in) in)
|
||||
|
|
|
|||
|
|
@ -157,19 +157,26 @@
|
|||
table))
|
||||
|
||||
(defconst fuel-syntax--syntactic-keywords
|
||||
`(("\\_<\\(#?!\\) .*\\(\n\\)" (1 "<") (2 ">"))
|
||||
("\\_<\\(#?!\\)\\(\n\\)" (1 "<") (2 ">"))
|
||||
`(;; Comments:
|
||||
("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
|
||||
("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
|
||||
;; CHARs:
|
||||
("CHAR: \\(.\\)\\( \\|$\\)" (1 "w"))
|
||||
;; Let and lambda:
|
||||
("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
|
||||
("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
|
||||
("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
|
||||
(" \\(|\\) " (1 "(|"))
|
||||
(" \\(|\\)$" (1 ")"))
|
||||
("CHAR: \\(\"\\)\\( \\|$\\)" (1 "w"))
|
||||
;; Opening brace words:
|
||||
(,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}"))
|
||||
("\\_<\\({\\)\\_>" (1 "(}"))
|
||||
("\\_<\\(}\\)\\_>" (1 "){"))
|
||||
;; Parenthesis:
|
||||
("\\_<\\((\\)\\_>" (1 "()"))
|
||||
("\\_<\\()\\)\\_>" (1 ")("))
|
||||
;; Quotations:
|
||||
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
|
||||
("\\_<\\(\\[\\)\\_>" (1 "(]"))
|
||||
("\\_<\\(\\]\\)\\_>" (1 ")["))))
|
||||
|
||||
|
|
@ -318,9 +325,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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue