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

extra/animations/animations-docs.factor

@@ -0,0 +1,34 @@
+USING: help.markup help.syntax ;
+IN: extra.animations
+
+HELP: animate ( quot duration -- )
+{ $values
+    { "quot" "a quot which uses " { $link progress } }
+    { "duration" "a duration of time" }
+}
+{ $description { $link animate } " calls " { $link reset-progress } " , then continously calls the given quot until the duration of time has elapsed. The quot should use " { $link progress } " at least once."  }
+{ $example 
+    "USING: extra.animations calendar threads prettyprint ;"
+    "[ 1 sleep progress unparse write \" ms elapsed\" print ] 1/20 seconds animate ;"
+    "46 ms elapsed\n17 ms elapsed"
+} ;
+
+HELP: reset-progress ( -- )
+{ $description "Initiates the timer. Call this before using a loop which makes use of " { $link progress } "." } ;
+
+HELP: progress ( -- time )
+{ $values { "time" "an integer" } }
+{ $description "Gives the time elapsed since the last time this word was called, in milliseconds." }
+{ $example
+    "USING: extra.animations threads prettyprint ;"
+    "reset-progress 3 [ 1 sleep progress unparse write \"ms elapsed\" print ] times ;"
+    "31 ms elapsed\n18 ms elapsed\n16 ms elapsed"
+} ;
+
+ARTICLE: "extra.animations" "Animations"
+"Provides a lightweight framework for properly simulating continuous functions of real time. This framework helps one create animations that use rates which do not change across platforms. The speed of the computer should correlate with the smoothness of the animation, not the speed of the animation!"
+{ $subsection animate }
+{ $subsection reset-progress }
+{ $subsection progress }
+{ $link progress } " specifically provides the length of time since " { $link reset-progress } " was called, and also calls " { $link reset-progress } " as its last action. This can be directly used when one's quote runs for a specific number of iterations, instead of a length of time. If the animation is like most, and is expected to run for a specific length of time, " { $link animate } " should be used." ;
+ABOUT: "extra.animations"

extra/animations/animations.factor

@@ -0,0 +1,12 @@
+! Small library for cross-platform continuous functions of real time
+
+USING: kernel shuffle system locals
+prettyprint math io namespaces threads calendar ;
+IN: extra.animations
+
+SYMBOL: last-loop
+: reset-progress ( -- ) millis last-loop set ;
+: progress ( -- progress ) millis last-loop get - reset-progress ;
+: set-end ( duration -- end-time ) dt>milliseconds millis + ;
+: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ;
+: animate ( quot duration -- ) reset-progress set-end loop ;

extra/animations/authors.txt

@@ -0,0 +1 @@
+Reginald Keith Ford II

extra/csv/csv.factor

@@ -4,12 +4,16 @@
 ! Simple CSV Parser
 ! Phil Dawes phil@phildawes.net
 
-USING: kernel sequences io namespaces combinators unicode.categories vars ;
+USING: kernel sequences io namespaces combinators unicode.categories ;
 IN: csv
 
-DEFER: quoted-field
+SYMBOL: delimiter
 
-VAR: delimiter
+CHAR: , delimiter set-global
+
+: delimiter> delimiter get ; inline
+    
+DEFER: quoted-field ( -- endchar )
     
 ! trims whitespace from either end of string
 : trim-whitespace ( str -- str )
@@ -44,7 +48,7 @@ VAR: delimiter
 
 : (row) ( -- sep )
   field , 
-  dup delimiter> = [ drop (row) ] when ;
+  dup delimiter get = [ drop (row) ] when ;
 
 : row ( -- eof? array[string] )
   [ (row) ] { } make ;
@@ -55,25 +59,18 @@ VAR: delimiter
 : (csv) ( -- )
   row append-if-row-not-empty
   [ (csv) ] when ;
-
-: init-vars ( -- )
-  delimiter> [ CHAR: , >delimiter ] unless ; inline 
   
 : csv-row ( stream -- row )
-  init-vars
   [ row nip ] with-input-stream ;
 
 : csv ( stream -- rows )
-  init-vars
   [ [ (csv) ] { } make ] with-input-stream ;
 
 : with-delimiter ( char quot -- )
   delimiter swap with-variable ; inline
 
-
-    
 : needs-escaping? ( cell -- ? )
-  [ "\n\"" delimiter> suffix member? ] contains? ; inline ! "
+  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! "
 
 : escape-quotes ( cell -- cell' )
   [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline
@@ -85,8 +82,7 @@ VAR: delimiter
   dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline
     
 : write-row ( row -- )
-  [ delimiter> write1 ] [ escape-if-required write ] interleave nl ; inline
+  [ delimiter get write1 ] [ escape-if-required write ] interleave nl ; inline
     
 : write-csv ( rows outstream -- )
-  init-vars
   [ [ write-row ] each ] with-output-stream ;

extra/math/derivatives/derivatives.factor

@@ -3,7 +3,8 @@
 USING: kernel math math.points math.function-tools ;
 IN: math.derivatives
 
-: small-amount ( -- n ) 1.0e-12 ;
-: near ( x -- y ) small-amount + ;
-: derivative ( x function -- m ) 2dup [ near ] dip [ eval ] 2bi@ slope ;
+: small-amount ( -- n ) 1.0e-14 ;
+: some-more ( x -- y ) small-amount + ;
+: some-less ( x -- y ) small-amount - ;
+: derivative ( x function -- m ) [ [ some-more ] dip eval ] [ [ some-less ] dip eval ] 2bi slope ;
 : derivative-func ( function -- function ) [ derivative ] curry ;

extra/math/function-tools/function-tools.factor

@@ -1,8 +1,9 @@
 ! Copyright © 2008 Reginald Keith Ford II
 ! Tools for quickly comparing, transforming, and evaluating mathematical Factor functions
 
-USING: kernel math arrays ;
+USING: kernel math arrays sequences sequences.lib ;
 IN: math.function-tools 
 : difference-func ( func func -- func ) [ bi - ] 2curry ;
 : eval ( x func -- pt ) dupd call 2array ;
+: eval-inverse ( y func -- pt ) dupd call swap 2array ;
 : eval3d ( x y func -- pt ) [ 2dup ] dip call 3array ;

extra/math/newtons-method/newtons-method.factor

@@ -1,4 +1,4 @@
-! Copyright © 2008 Reginald Keith Ford II
+! Copyright © 2008 Reginald Keith Ford II
 ! Newton's Method of approximating roots
 
 USING: kernel math math.derivatives ;
@@ -6,6 +6,6 @@ IN: math.newtons-method
 
 <PRIVATE
 : newton-step ( x function -- x2 ) dupd [ call ] [ derivative ] 2bi / - ;
-: newton-precision ( -- n ) 7 ;
+: newton-precision ( -- n ) 13 ;
 PRIVATE>
-: newton-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ;
+: newtons-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ;

extra/math/secant-method/secant-method.factor

@@ -7,8 +7,8 @@ IN: math.secant-method
 <PRIVATE
 : secant-solution ( x1 x2 function -- solution ) [ eval ] curry bi@ linear-solution ;
 : secant-step ( x1 x2 func -- x2 x3 func ) 2dup [ secant-solution ] 2dip swapd ;
-: secant-precision ( -- n ) 11 ;
+: secant-precision ( -- n ) 15 ;
 PRIVATE>
-: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop v+ 2 v*n ;
+: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop + 2 / ;
 ! : close-enough? ( a b -- t/f ) - abs tiny-amount < ;
 ! : secant-method2 ( left right function -- x ) 2over close-enough? [ drop average ] [ secant-step secant-method ] if  ;

extra/wordtimer/wordtimer-docs.factor

@@ -34,8 +34,13 @@ HELP: profile-vocab
 { $description "Annotates the words in the vocab with timing code then runs the quotation. Finally resets the words and prints the timings information."
 } ;
 
+HELP: wordtimer-call
+{ $values { "quot" "a quotation to run" } }
+{ $description "Resets the wordtimer hash and runs the quotation. After the quotation has run it prints out the timed words"
+} ;
+
     
 ARTICLE: "wordtimer" "Word Timer"
-"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } ". Alternatively if you just want to time the contents of a vocabulary you can use profile-vocab." ;
+"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then use " { $link wordtimer-call } " to invoke a quotation and print out the timings." ;
     
 ABOUT: "wordtimer"

extra/wordtimer/wordtimer.factor

@@ -67,6 +67,12 @@ SYMBOL: *calling*
 : print-word-timings ( -- )
   *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ;
 
+: wordtimer-call ( quot -- )
+  reset-word-timer 
+  [ call ] micro-time >r
+  correct-for-timing-overhead
+  "total time:" write r> pprint nl
+  print-word-timings nl ;
 
 : profile-vocab ( vocabspec quot -- )
   "annotating vocab..." print flush

unfinished/compiler/tree/propagation/propagation-tests.factor

@@ -536,3 +536,15 @@ M: array iterate first t ;
 [ V{ f } ] [
     [ 10 eq? [ drop 3 ] unless ] final-literals
 ] unit-test
+
+GENERIC: bad-generic ( a -- b )
+M: fixnum bad-generic 1 fixnum+fast ;
+: bad-behavior 4 bad-generic ; inline recursive
+
+[ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test
+
+[ V{ number } ] [
+    [
+        0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times
+    ] final-classes
+] unit-test