: remove-pending ( live-interval -- )
vreg>> pending-interval-assoc get delete-at ;
+ERROR: bad-vreg vreg ;
+
: (vreg>reg) ( vreg pending -- reg )
! If a live vreg is not in the pending set, then it must
! have been spilled.
- ?at [ spill-slots get at <spill-slot> ] unless ;
+ ?at [ spill-slots get ?at [ <spill-slot> ] [ bad-vreg ] if ] unless ;
: vreg>reg ( vreg -- reg )
pending-interval-assoc get (vreg>reg) ;
: end-block ( bb -- )
[ live-out vregs>regs ] keep register-live-outs get set-at ;
-ERROR: bad-vreg vreg ;
-
: vreg-at-start ( vreg bb -- state )
register-live-ins get at ?at [ bad-vreg ] unless ;
compiler.cfg.linearization.order ;
IN: compiler.cfg.linear-scan.numbering
-: number-instructions ( rpo -- )
- linearization-order 0 [
- instructions>> [
- [ (>>insn#) ] [ drop 2 + ] 2bi
- ] each
- ] reduce drop ;
+ERROR: already-numbered insn ;
+
+: number-instruction ( n insn -- n' )
+ [ nip dup insn#>> [ already-numbered ] [ drop ] if ]
+ [ (>>insn#) ]
+ [ drop 2 + ]
+ 2tri ;
+
+: number-instructions ( cfg -- )
+ linearization-order
+ 0 [ instructions>> [ number-instruction ] each ] reduce
+ drop ;
SYMBOL: check-numbering?
--- /dev/null
+USING: compiler.cfg.debugger compiler.cfg compiler.cfg.linearization.order
+kernel accessors sequences sets tools.test namespaces ;
+IN: compiler.cfg.linearization.order.tests
+
+V{ } 0 test-bb
+
+V{ } 1 test-bb
+
+V{ } 2 test-bb
+
+0 { 1 1 } edges
+1 2 edge
+
+[ t ] [ cfg new 0 get >>entry linearization-order [ id>> ] map all-unique? ] unit-test
USING: accessors assocs deques dlists kernel make sorting
namespaces sequences combinators combinators.short-circuit
fry math sets compiler.cfg.rpo compiler.cfg.utilities
-compiler.cfg.loop-detection ;
+compiler.cfg.loop-detection compiler.cfg.predecessors ;
IN: compiler.cfg.linearization.order
! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp
successors>> <reversed> [ loop-nesting-at ] sort-with ;
: process-block ( bb -- )
- [ , ]
- [ visited get conjoin ]
- [ sorted-successors [ process-successor ] each ]
- tri ;
+ dup visited? [ drop ] [
+ [ , ]
+ [ visited get conjoin ]
+ [ sorted-successors [ process-successor ] each ]
+ tri
+ ] if ;
: (linearization-order) ( cfg -- bbs )
init-linearization-order
PRIVATE>
: linearization-order ( cfg -- bbs )
- needs-post-order needs-loops
+ needs-post-order needs-loops needs-predecessors
dup linear-order>> [ ] [
dup (linearization-order)
[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
+
+! Bug in linearization
+[ 283686952174081 ] [
+ B{ 1 1 1 1 } [
+ { byte-array } declare
+ [ 0 2 ] dip
+ [
+ [ drop ] 2dip
+ [
+ swap 1 < [ [ ] dip ] [ [ ] dip ] if
+ 0 alien-signed-4
+ ] curry dup bi *
+ ] curry each-integer
+ ] compile-call
+] unit-test
compile-cfg ;
: compile-test-bb ( insns -- result )
- V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+ V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb
V{
T{ ##inc-d f 1 }
T{ ##replace f 0 D 0 }
[ t ] [
V{
T{ ##load-reference f 0 { t f t } }
- T{ ##slot-imm f 0 0 2 $[ array tag-number ] 2 }
+ T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
} compile-test-bb
] unit-test
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
compiler.units compiler.constants compiler.codegen vm ;
FROM: cpu.ppc.assembler => B ;
+FROM: layouts => cell ;
FROM: math => float ;
IN: cpu.ppc
[ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
[ f ] [ -4.0000001 4.0000001 .00001 ~ ] unit-test
[ t ] [ -.0000000000001 0 .0000000001 ~ ] unit-test
+[ t ] [ 100 101 -.9 ~ ] unit-test
+[ f ] [ 100 120 -.09 ~ ] unit-test
+[ t ] [ 0 0 -.9 ~ ] unit-test
+[ f ] [ 0 10 -.9 ~ ] unit-test
! Lets get the argument order correct, eh?
[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test
[ - abs ] dip < ;
: ~rel ( x y epsilon -- ? )
- [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ;
+ [ [ - abs ] 2keep [ abs ] bi@ + ] dip * <= ;
: ~ ( x y epsilon -- ? )
{
{ [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
{ [ dup zero? ] [ drop number= ] }
- { [ dup 0 < ] [ ~rel ] }
+ { [ dup 0 < ] [ neg ~rel ] }
[ ~abs ]
} cond ;
"Printing messages when a word is called or returns:"
{ $subsection watch }
{ $subsection watch-vars }
-"Starting the walker when a word is called:"
-{ $subsection breakpoint }
-{ $subsection breakpoint-if }
"Timing words:"
{ $subsection reset-word-timing }
{ $subsection add-timing }
{ watch watch-vars reset } related-words
-HELP: breakpoint
-{ $values { "word" word } }
-{ $description "Annotates a word definition to enter the single stepper when executed." } ;
-
-HELP: breakpoint-if
-{ $values { "quot" { $quotation "( -- ? )" } } { "word" word } }
-{ $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ;
-
HELP: reset
{ $values
{ "word" word } }
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math sorting words parser io summary
quotations sequences prettyprint continuations effects
-definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry tools.continuations
-locals generalizations macros ;
+definitions compiler.units namespaces assocs tools.time generic
+inspector fry locals generalizations macros ;
IN: tools.annotations
<PRIVATE
: watch-vars ( word vars -- )
dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
-: breakpoint ( word -- )
- [ add-breakpoint ] annotate ;
-
-: breakpoint-if ( word quot -- )
- '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ;
-
SYMBOL: word-timing
word-timing [ H{ } clone ] initialize
IN: tools.walker
-USING: help.syntax help.markup tools.continuations ;
+USING: help.syntax help.markup tools.continuations sequences math words ;
+
+HELP: breakpoint
+{ $values { "word" word } }
+{ $description "Annotates a word definition to enter the single stepper when executed." } ;
+
+HELP: breakpoint-if
+{ $values { "quot" { $quotation "( -- ? )" } } { "word" word } }
+{ $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ;
HELP: B
-{ $description "An alias for " { $link break } ", defined in the " { $vocab-link "syntax" } " vocabulary so that it is always available." } ;
\ No newline at end of file
+{ $description "An alias for " { $link break } ", defined in the " { $vocab-link "syntax" } " vocabulary so that it is always available." } ;
+
+ARTICLE: "breakpoints" "Setting breakpoints"
+"In addition to invoking the walker explicitly through the UI, it is possible to set breakpoints on words using words in the " { $vocab-link "tools.walker" } " vocabulary."
+$nl
+"Annotating a word with a breakpoint (see " { $link "tools.annotations" } "):"
+{ $subsection breakpoint }
+{ $subsection breakpoint-if }
+"Breakpoints can be inserted directly into code:"
+{ $subsection break }
+{ $subsection POSTPONE: B }
+"Note that because the walker calls various core library and UI words while rendering its own user interface, setting a breakpoint on a word such as " { $link append } " or " { $link + } " will hang the UI." ;
+
+ABOUT: "breakpoints"
concurrency.messaging quotations kernel.private words
sequences.private assocs models models.arrow arrays accessors
generic generic.standard definitions make sbufs
-tools.continuations parser ;
+tools.continuations parser tools.annotations fry ;
IN: tools.walker
SYMBOL: show-walker-hook ! ( status continuation thread -- )
"Walker on " self name>> append spawn
[ associate-thread ] keep ;
+: breakpoint ( word -- )
+ [ add-breakpoint ] annotate ;
+
+: breakpoint-if ( word quot -- )
+ '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ;
+
! For convenience
IN: syntax
$nl\r
"The " { $link com-back } " command travels backwards through time, and restore stacks. This does not undo side effects (modifying array entries, writing to files, formatting the hard drive, etc) and therefore can only be used reliably on referentially transparent code." ;\r
\r
-ARTICLE: "breakpoints" "Setting breakpoints"\r
-"In addition to invoking the walker explicitly through the UI, it is possible to set breakpoints on words. See " { $link "tools.annotations" } "."\r
-$nl\r
-"Breakpoints can be inserted directly into code:"\r
-{ $subsection break }\r
-{ $subsection POSTPONE: B }\r
-"Note that because the walker calls various core library and UI words while rendering its own user interface, setting a breakpoint on a word such as " { $link append } " or " { $link draw-gadget } " will hang the UI." ;\r
-\r
ARTICLE: "ui-walker" "UI walker"\r
"The walker single-steps through quotations. To use the walker, enter a piece of code in the listener's input area and press " { $operation walk } "."\r
$nl\r
-USING: accessors alien arrays definitions generic generic.standard
-generic.math assocs hashtables io kernel math namespaces parser
-prettyprint sequences strings tools.test vectors words
-quotations classes classes.algebra classes.tuple continuations
-layouts classes.union sorting compiler.units eval io.streams.string ;
+USING: accessors alien arrays assocs classes classes.algebra
+classes.tuple classes.union compiler.units continuations
+definitions eval generic generic.math generic.standard
+hashtables io io.streams.string kernel layouts math math.order
+namespaces parser prettyprint quotations sequences sorting
+strings tools.test vectors words ;
IN: generic.tests
GENERIC: foobar ( x -- y )
fixnum \ <=> method-for-class
real \ <=> method
eq?
-] unit-test
\ No newline at end of file
+] unit-test
--- /dev/null
+IN: compiler.graphviz.tests
+USING: compiler.graphviz io.files kernel tools.test ;
+
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-call-graph exists? ] unit-test
"}" ,
] { } make , ; inline
-: render-graph ( quot -- )
+: render-graph ( quot -- name )
{ } make
"cfg" ".dot" make-unique-file
dup "Wrote " prepend print
[ [ concat ] dip ascii set-file-lines ]
[ { "dot" "-Tpng" "-O" } swap suffix try-process ]
- [ ".png" append "open" swap 2array try-process ]
+ [ ".png" append ]
tri ; inline
+: display-graph ( name -- )
+ "open" swap 2array try-process ;
+
: attrs>string ( seq -- str )
[ "" ] [ "," join "[" "]" surround ] if-empty ;
: optimized-cfg ( quot -- cfgs )
{
{ [ dup cfg? ] [ 1array ] }
- { [ dup quotation? ] [ test-cfg [ optimize-cfg ] map ] }
- { [ dup word? ] [ test-cfg [ optimize-cfg ] map ] }
+ { [ dup quotation? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
+ { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
[ ]
} cond ;
-: render-cfg ( cfg -- )
+: render-cfg ( cfg -- name )
optimized-cfg [ cfgs ] render-graph ;
: dom-trees ( cfgs -- )
] over cfg-title graph,
] each ;
-: render-dom ( cfg -- )
+: render-dom ( cfg -- name )
optimized-cfg [ dom-trees ] render-graph ;
SYMBOL: word-counts
H{ } clone vertex-names set
[ "ROOT" ] dip (call-graph-edges) ;
-: render-call-graph ( tree -- )
+: render-call-graph ( tree -- name )
dup quotation? [ build-tree ] when
analyze-recursive drop
[ [ call-graph get call-graph-edges ] "Call graph" graph, ]
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: slides help.markup math math.private kernel sequences
+slots.private ;
+IN: jvm-summit-talk
+
+CONSTANT: jvm-summit-slides
+{
+ { $slide "Factor language implementation"
+ "Goals: expressiveness, metaprogramming, performance"
+ "We want a language for anything from scripting DSLs to high-performance numerics"
+ "I assume you know a bit about compiler implementation: parser -> frontend -> optimizer -> codegen"
+ { "This is " { $strong "not" } " a talk about the Factor language" }
+ { "Go to " { $url "http://factorcode.org" } " to learn the language" }
+ }
+ { $slide "Why are dynamic languages slow?"
+ "Branching and indirection!"
+ "Runtime type checks and dispatch"
+ "Integer overflow checks"
+ "Boxed integers and floats"
+ "Lots of allocation of temporary objects"
+ }
+ { $slide "Interactive development"
+ "Code can be reloaded at any time"
+ "Class hierarchy might change"
+ "Slots may be added and removed"
+ "Functions might be redefined"
+ }
+ { $slide "Factor's solution"
+ "Factor implements most of the library in Factor"
+ "Library contains very generic, high-level code"
+ "Always compiles to native code"
+ "Compiler removes unused generality from high-level code"
+ "Inlining, specialization, partial evaluation"
+ "And deoptimize when assumptions change"
+ }
+ { $slide "Introduction: SSA form"
+ "Every identifier only has one global definition"
+ {
+ "Not SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x = x + y"
+ "if(z < 0)"
+ " t = x + y"
+ "else"
+ " t = x - y"
+ "print(t)"
+ }
+ }
+ }
+ { $slide "Introduction: SSA form"
+ "Rename re-definitions and subsequent usages"
+ {
+ "Still not SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x1 = x + y"
+ "if(z < 0)"
+ " t = x1 + y"
+ "else"
+ " t = x1 - y"
+ "print(t)"
+ }
+ }
+ }
+ { $slide "Introduction: SSA form"
+ "Introduce “φ functions” at control-flow merge points"
+ {
+ "This is SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x1 = x + y"
+ "if(z < 0)"
+ " t1 = x1 + y"
+ "else"
+ " t2 = x1 - y"
+ "t3 = φ(t1,t2)"
+ "print(t3)"
+ }
+ }
+ }
+ { $slide "Why SSA form?"
+ {
+ "Def-use chains:"
+ { $list
+ "Defs-of: instructions that define a value"
+ "Uses-of: instructions that use a value"
+ }
+ "With SSA, defs-of has exactly one element"
+ }
+ }
+ { $slide "Def-use chains"
+ "Simpler def-use makes analysis more accurate."
+ {
+ "Non-SSA example:"
+ { $code
+ "if(x < 0)"
+ " s = new Circle"
+ " a = area(s1)"
+ "else"
+ " s = new Rectangle"
+ " a = area(s2)"
+ }
+ }
+ }
+ { $slide "Def-use chains"
+ {
+ "SSA example:"
+ { $code
+ "if(x < 0)"
+ " s1 = new Circle"
+ " a1 = area(s1)"
+ "else"
+ " s2 = new Rectangle"
+ " a2 = area(s2)"
+ "a = φ(a1,a2)"
+ }
+
+ }
+ }
+ { $slide "Factor compiler overview"
+ "High-level SSA IR constructed from stack code"
+ "High level optimizer transforms high-level IR"
+ "Low-level SSA IR is constructed from high-level IR"
+ "Low level optimizer transforms low-level IR"
+ "Register allocator runs on low-level IR"
+ "Machine IR is constructed from low-level IR"
+ "Code generation"
+ }
+ { $slide "High-level optimizer"
+ "Frontend: expands macros, inline higher order functions"
+ "Propagation: inline methods, constant folding"
+ "Escape analysis: unbox tuples"
+ "Dead code elimination: clean up"
+ }
+ { $slide "Higher-order functions"
+ "Almost all control flow is done with higher-order functions"
+ { { $link if } ", " { $link times } ", " { $link each } }
+ "Calling a block is an indirect jump"
+ "Solution: inline higher order functions at the call site"
+ "Inline the block body at the higher order call site in the function"
+ "Record inlining in deoptimization database"
+ }
+ { $slide "Generic functions"
+ "A generic function contains multiple method bodies"
+ "Dispatches on the class of argument(s)"
+ "In Factor, generic functions are single dispatch"
+ "Almost equivalent to message passing"
+ }
+ { $slide "Tuple slot access"
+ "Slot readers and writers are generic functions"
+ "Generated automatically when you define a tuple class"
+ { "The generated methods call " { $link slot } ", " { $link set-slot } " primitives" }
+ "These primitives are not type safe; the generic dispatch performs the type checking for us"
+ "If class of dispatch value known statically, inline method"
+ "This may result in more methods inlining from additional specialization"
+ }
+ { $slide "Generic arithmetic"
+ { { $link + } ", " { $link * } ", etc perform a double dispatch on arguments" }
+ { "Fixed-precision integers (" { $link fixnum } "s) upgrade to " { $link bignum } "s automatically" }
+ "Floats and complex numbers are boxed, heap-allocated"
+ "Propagation of classes helps for floats"
+ "But not for fixnums, because of overflow checks"
+ "So we also propagate integer intervals"
+ "Interval arithmetic: etc, [a,b] + [c,d] = [a+c,b+d]"
+ }
+ { $slide "Slot value propagation"
+ "Complex numbers are even trickier"
+ "We can have a complex number with integer components, float components"
+ "Even if we inline complex arithmetic methods, still dispatching on components"
+ "Solution: propagate slot info"
+ }
+ { $slide "Constrant propagation"
+ "Contrieved example:"
+ { $code
+ "x = •"
+ "b = isa(x,array)"
+ "if(b)"
+ " a = length(x)"
+ "else"
+ " b = length(x)"
+ "c = φ(a,b)"
+ }
+ { "We should be able to inline the call to " { $snippet "length" } " in the true branch" }
+ }
+ { $slide "Constrant propagation"
+ "We build a table:"
+ { $code
+ "b true => x is array"
+ "b false => x is ~array"
+ }
+ { "In true branch, apply all " { $snippet "b true" } " constraints" }
+ { "In false branch, apply all " { $snippet "b false" } " constraints" }
+ }
+ { $slide "Going further"
+ "High-level optimizer eliminates some dispatch overhead and allocation"
+ {
+ { "Let's take a look at the " { $link float+ } " primitive" }
+ { $list
+ "No type checking anymore... but"
+ "Loads two tagged pointers from operand stack"
+ "Unboxes floats"
+ "Adds two floats"
+ "Boxes float result and perform a GC check"
+ }
+ }
+ }
+ { $slide "Low-level optimizer"
+ "Frontend: construct LL SSA IR from HL SSA IR"
+ "Alias analysis: remove redundant slot loads/stores"
+ "Value numbering: simplify arithmetic"
+ "Representation selection: eliminate boxing"
+ "Dead code elimination: clean up"
+ "Register allocation"
+ }
+ { $slide "Constructing low-level IR"
+ { "Low-level IR is a " { $emphasis "control flow graph" } " of " { $emphasis "basic blocks" } }
+ "A basic block is a list of instructions"
+ "Register-based IR; infinite, uniform register file"
+ { "Instructions:"
+ { $list
+ "Subroutine calls"
+ "Machine arithmetic"
+ "Load/store values on operand stack"
+ "Box/unbox values"
+ }
+ }
+ }
+ { $slide "Inline allocation and GC checks"
+ {
+ "Allocation of small objects can be done in a few instructions:"
+ { $list
+ "Bump allocation pointer"
+ "Write object header"
+ "Fill in payload"
+ }
+ }
+ "Multiple allocations in the same basic block only need a single GC check; saves on a conditional branch"
+ }
+ { $slide "Alias analysis"
+ "Factor constructors are just ordinary functions"
+ { "They call a primitive constructor: " { $link new } }
+ "When a new object is constructed, it has to be initialized"
+ "... but the user's constructor probably fills in all the slots again with actual values"
+ "Local alias analysis eliminates redundant slot loads and stores"
+ }
+ { $slide "Value numbering"
+ { "A form of " { $emphasis "redundancy elimination" } }
+ "Requires use of SSA form in order to work"
+ "Define an equivalence relation over SSA values"
+ "Assign a “value number” to each SSA value"
+ "If two values have the same number, they will always be equal at runtime"
+ }
+ { $slide "Types of value numbering"
+ "Many variations: algebraic simplifications, various rewrite rules can be tacked on"
+ "Local value numbering: in basic blocks"
+ "Global value numbering: entire procedure"
+ "Factor only does local value numbering"
+ }
+ { $slide "Value graph and expressions"
+ { $table
+ {
+ {
+ "Basic block:"
+ { $code
+ "x = •"
+ "y = •"
+ "a = x + 1"
+ "b = a + 1"
+ "c = x + 2"
+ "d = b - c"
+ "e = y + d"
+ }
+ }
+ {
+ "Value numbers:"
+ { $code
+ "V1: •"
+ "V2: •"
+ "V3: 1"
+ "V4: 2"
+ "V5: (V1 + V3)"
+ "V6: (V5 + V3)"
+ "V7: (V3 + V4)"
+ "V8: (V6 - V7)"
+ "V9: (V2 + V8)"
+ }
+ }
+ }
+ }
+ }
+ { $slide "Expression simplification"
+ {
+ "Constant folding: if V1 and V2 are constants "
+ { $snippet "(V1 op V2)" }
+ " can be evaluated at compile-time"
+ }
+ {
+ "Reassociation: if V2 and V3 are constants "
+ { $code "((V1 op V2) op V3) => (V1 op (V2 op V3))" }
+ }
+ {
+ "Algebraic identities: if V2 is constant 0, "
+ { $code "(V1 + V2) => V1" }
+ }
+ {
+ "Strength reduction: if V2 is a constant power of two, "
+ { $code "(V1 * V2) => (V1 << log2(V2))" }
+ }
+ "etc, etc, etc"
+ }
+ { $slide "Representation selection overview"
+ "Floats and SIMD vectors need to be boxed"
+ "Representation: tagged pointer, unboxed float, unboxed SIMD value..."
+ "When IR is built, no boxing or unboxing instructions inserted"
+ "Representation selection pass makes IR consistent"
+ }
+ { $slide "Representation selection algorithm"
+ {
+ "For each SSA value:"
+ { $list
+ "Compute possible representations"
+ "Compute cost of each representation"
+ "Pick representation with minimum cost"
+ }
+ }
+ {
+ "For each instruction:"
+ { $list
+ "If it expects a value to be in a different representation, insert box or unbox code"
+ }
+ }
+ }
+ { $slide "Register allocation"
+ "Linear scan algorithm used in Java HotSpot Client"
+ "Described in Christian Wimmer's masters thesis"
+ "Works fine on x86-64, not too great on x86-32"
+ "Good enough since basic blocks tend to be short, with lots of procedure calls"
+ "Might switch to graph coloring eventually"
+ }
+ { $slide "Compiler tools"
+ "Printing high level IR"
+ "Printing low level IR"
+ "Disassembly"
+ "Display call tree"
+ "Display control flow graph"
+ "Display dominator tree"
+ }
+}
+
+: jvm-summit-talk ( -- )
+ jvm-summit-slides slides-window ;
+
+MAIN: jvm-summit-talk
--- /dev/null
+Slides from Slava's talk at JVM Language Summit 2009
--- /dev/null
+USING: project-euler.072 tools.test ;
+IN: project-euler.072.tests
+
+[ 303963552391 ] [ euler072 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.primes.factors math.ranges
+project-euler.common sequences ;
+IN: project-euler.072
+
+! http://projecteuler.net/index.php?section=problems&id=072
+
+! DESCRIPTION
+! -----------
+
+! Consider the fraction, n/d, where n and d are positive integers.
+! If n<d and HCF(n,d)=1, it is called a reduced proper fraction.
+
+! If we list the set of reduced proper fractions for d ≤ 8 in ascending order
+! of size, we get:
+
+! 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3,
+! 5/7, 3/4, 4/5, 5/6, 6/7, 7/8
+
+! It can be seen that there are 21 elements in this set.
+
+! How many elements would be contained in the set of reduced proper fractions
+! for d ≤ 1,000,000?
+
+
+! SOLUTION
+! --------
+
+! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
+
+: euler072 ( -- answer )
+ 2 1000000 [a,b] [ totient ] [ + ] map-reduce ;
+
+! [ euler072 ] 100 ave-time
+! 5274 ms ave run time - 102.7 SD (100 trials)
+
+SOLUTION: euler072
--- /dev/null
+USING: project-euler.074 tools.test ;
+IN: project-euler.074.tests
+
+[ 402 ] [ euler074 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs hashtables kernel math math.ranges
+project-euler.common sequences sets ;
+IN: project-euler.074
+
+! http://projecteuler.net/index.php?section=problems&id=074
+
+! DESCRIPTION
+! -----------
+
+! The number 145 is well known for the property that the sum of the factorial
+! of its digits is equal to 145:
+
+! 1! + 4! + 5! = 1 + 24 + 120 = 145
+
+! Perhaps less well known is 169, in that it produces the longest chain of
+! numbers that link back to 169; it turns out that there are only three such
+! loops that exist:
+
+! 169 → 363601 → 1454 → 169
+! 871 → 45361 → 871
+! 872 → 45362 → 872
+
+! It is not difficult to prove that EVERY starting number will eventually get
+! stuck in a loop. For example,
+
+! 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
+! 78 → 45360 → 871 → 45361 (→ 871)
+! 540 → 145 (→ 145)
+
+! Starting with 69 produces a chain of five non-repeating terms, but the
+! longest non-repeating chain with a starting number below one million is sixty
+! terms.
+
+! How many chains, with a starting number below one million, contain exactly
+! sixty non-repeating terms?
+
+
+! SOLUTION
+! --------
+
+! Brute force
+
+<PRIVATE
+
+: digit-factorial ( n -- n! )
+ { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
+
+: digits-factorial-sum ( n -- n )
+ number>digits [ digit-factorial ] sigma ;
+
+: chain-length ( n -- n )
+ 61 <hashtable>
+ [ 2dup key? not ]
+ [ [ conjoin ] [ [ digits-factorial-sum ] dip ] 2bi ]
+ while nip assoc-size ;
+
+PRIVATE>
+
+: euler074 ( -- answer )
+ 1000000 [1,b] [ chain-length 60 = ] count ;
+
+! [ euler074 ] 10 ave-time
+! 25134 ms ave run time - 31.96 SD (10 trials)
+
+SOLUTION: euler074
+
! SOLUTION
! --------
-! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles.
+! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4 rectangles.
<PRIVATE
area-of-nearest ;
! [ euler085 ] 100 ave-time
-! 2285 ms ave run time - 4.8 SD (100 trials)
+! 791 ms ave run time - 17.15 SD (100 trials)
SOLUTION: euler085
--- /dev/null
+USING: project-euler.124 tools.test ;
+IN: project-euler.124.tests
+
+[ 21417 ] [ euler124 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math.primes.factors
+math.ranges project-euler.common sequences sorting ;
+IN: project-euler.124
+
+! http://projecteuler.net/index.php?section=problems&id=124
+
+! DESCRIPTION
+! -----------
+
+! The radical of n, rad(n), is the product of distinct prime factors of n.
+! For example, 504 = 2^3 × 3^2 × 7, so rad(504) = 2 × 3 × 7 = 42.
+
+! If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n),
+! and sorting on n if the radical values are equal, we get:
+
+! Unsorted Sorted
+! n rad(n) n rad(n) k
+! 1 1 1 1 1
+! 2 2 2 2 2
+! 3 3 4 2 3
+! 4 2 8 2 4
+! 5 5 3 3 5
+! 6 6 9 3 6
+! 7 7 5 5 7
+! 8 2 6 6 8
+! 9 3 7 7 9
+! 10 10 10 10 10
+
+! Let E(k) be the kth element in the sorted n column; for example,
+! E(4) = 8 and E(6) = 9.
+
+! If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000).
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: rad ( n -- n )
+ unique-factors product ; inline
+
+: rads-upto ( n -- seq )
+ [0,b] [ dup rad 2array ] map ;
+
+: (euler124) ( -- seq )
+ 100000 rads-upto sort-values ;
+
+PRIVATE>
+
+: euler124 ( -- answer )
+ 10000 (euler124) nth first ;
+
+! [ euler124 ] 100 ave-time
+! 373 ms ave run time - 17.61 SD (100 trials)
+
+! TODO: instead of the brute-force method, making the rad
+! array in the way of the sieve of eratosthene would scale
+! better on bigger values.
+
+SOLUTION: euler124
project-euler.049 project-euler.052 project-euler.053 project-euler.054
project-euler.055 project-euler.056 project-euler.057 project-euler.058
project-euler.059 project-euler.063 project-euler.067 project-euler.069
- project-euler.071 project-euler.073 project-euler.075 project-euler.076
- project-euler.079 project-euler.085 project-euler.092 project-euler.097
- project-euler.099 project-euler.100 project-euler.102 project-euler.112
- 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.071 project-euler.072 project-euler.073 project-euler.074
+ project-euler.075 project-euler.076 project-euler.079 project-euler.085
+ project-euler.092 project-euler.097 project-euler.099 project-euler.100
+ project-euler.102 project-euler.112 project-euler.116 project-euler.117
+ project-euler.124 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
projects / factor.git / commitdiff