! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel math.constants math.private
+USING: math kernel math.constants math.private math.bits
math.libm combinators math.order sequences ;
IN: math.functions
M: real sqrt
>float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
-: each-bit ( n quot: ( ? -- ) -- )
- over [ 0 = ] [ -1 = ] bi or [
- 2drop
- ] [
- 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread
- ] if ; inline recursive
-
-: map-bits ( n quot: ( ? -- obj ) -- seq )
- accumulator [ each-bit ] dip ; inline
-
: factor-2s ( n -- r s )
#! factor an integer into 2^r * s
dup 0 = [ 1 ] [
- 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while
+ 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
] if ; inline
<PRIVATE
GENERIC# ^n 1 ( z w -- z^w )
: (^n) ( z w -- z^w )
- 1 swap [ [ dupd * ] when [ sq ] dip ] each-bit nip ; inline
+ make-bits 1 [ [ dupd * ] when [ sq ] dip ] reduce nip ; inline
M: integer ^n
[ factor-2s ] dip [ (^n) ] keep rot * shift ;
dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
: (^mod) ( n x y -- z )
- 1 swap [
+ make-bits 1 [
[ dupd * pick mod ] when [ sq over mod ] dip
- ] each-bit 2nip ; inline
+ ] reduce 2nip ; inline
: (gcd) ( b a x y -- a d )
over zero? [
sorting assocs definitions prettyprint io inspector
classes.tuple classes.union classes.predicate debugger
threads.private io.streams.string io.timeouts io.thread
-sequences.private destructors combinators eval locals.backend ;
+sequences.private destructors combinators eval locals.backend
+system ;
IN: stack-checker.tests
\ infer. must-infer
! Corner case
[ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail
- [ [ [ f dup ] [ ] [ ] while ] infer ] must-fail
+ [ [ [ f dup ] [ ] while ] infer ] must-fail
: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
: debugging-curry-folding ( quot -- )
[ debugging-curry-folding ] curry call ; inline recursive
-[ [ ] debugging-curry-folding ] must-infer
+[ [ ] debugging-curry-folding ] must-infer
+
+[ [ exit ] [ 1 2 3 ] if ] must-infer
sleep-queue
[ dup expire-sleep? ]
[ dup heap-pop drop expire-sleep ]
- [ ] while
+ while
drop ;
-: start ( namestack thread -- )
+: start ( namestack thread -- * )
[
set-self
set-namestack
{ $description "Clears the data stack." } ;
HELP: build
+{ $values { "n" integer } }
{ $description "The current build number. Factor increments this number whenever a new boot image is created." } ;
HELP: hashcode*
} ;
HELP: while
- { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+ { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
HELP: until
- { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+ { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;
HELP: do
- { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+ { $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Executes one iteration of a " { $link while } " or " { $link until } " loop." } ;
HELP: loop
"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
{ $subsection while }
{ $subsection until }
- "The above two combinators take a " { $snippet "tail" } " quotation. Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
- { $code
- "[ P ] [ Q ] [ T ] while"
- "[ P ] [ Q ] [ ] while T"
- }
- "However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference."
$nl
"To execute one iteration of a loop, use the following word:"
{ $subsection do }
\r
: write-color ( str color -- )\r
foreground associate format ;\r
-: dark-red T{ rgba f 0.5 0.0 0.0 1 } ;\r
-: dark-green T{ rgba f 0.0 0.5 0.0 1 } ;\r
-: dark-blue T{ rgba f 0.0 0.0 0.5 1 } ;\r
+CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 }\r
+CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 }\r
+CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 }\r
\r
: dot-or-parens ( string -- string )\r
[ "." ]\r
: display ( stream tab -- )\r
'[ _ [ [ t ]\r
[ _ dup chat>> hear handle-inbox ]\r
- [ ] while ] with-output-stream ] "ircv" spawn drop ;\r
+ while ] with-output-stream ] "ircv" spawn drop ;\r
\r
: <irc-pane> ( tab -- tab pane )\r
<scrolling-pane>\r
: $tetris ( element -- )
drop [ <default-tetris> <tetris-gadget> gadget. ] ($block) ;
-: otug-slides
+CONSTANT: otug-slides
{
{ $slide "Factor!"
{ $url "http://factorcode.org" }
}
{ $slide "Modifiers"
{ $code ": bank ( n -- n )" " readln string>number +" " dup \"Balance: $\" write . ;" }
- { $code "0 [ dup 0 > ] [ bank ] [ ] while" }
+ { $code "0 [ dup 0 > ] [ bank ] while" }
}
{ $slide "Modifiers"
{ $code "0 [ dup 0 > ] [ bank ] [ ] do while" }
"Factor has many cool things that I didn't talk about"
"Questions?"
}
-} ;
+}
: otug-talk ( -- ) otug-slides slides-window ;
projects / factor.git / commitdiff