diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 160dd23533..9b67f83ce7 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -14,7 +14,6 @@ + linearizer/generator: - peephole optimizer -- tail call optimization - getenv/setenv: if literal arg, compile as a load/store - compiler: drop literal peephole optimization @@ -35,7 +34,6 @@ + ffi: -- port ffi to new compiler - is signed -vs- unsigned pointers an issue? - bitfields in C structs - SDL_Rect** type @@ -68,7 +66,6 @@ + misc: -- some way to step over a word in the stepper - step: print NEXT word to execute, not word that JUST executed - perhaps /i should work with all numbers - unit test weirdness: 2 lines appears at end diff --git a/examples/factoroids.factor b/examples/factoroids.factor index 609543f842..d6209d4823 100644 --- a/examples/factoroids.factor +++ b/examples/factoroids.factor @@ -4,7 +4,6 @@ ! ! ./f factor.image -libraries:sdl=libSDL.so -libraries:sdl-gfx=libSDL_gfx.so ! -! "examples/oop.factor" run-file ! "examples/factoroids.factor" run-file IN: factoroids @@ -16,7 +15,7 @@ USE: lists USE: logic USE: math USE: namespaces -USE: oop +USE: generic USE: random USE: sdl USE: sdl-event @@ -116,18 +115,18 @@ M: ship draw ( actor -- ) [ surface get screen-xy radius get color get filledCircleColor - ] bind ;M + ] bind ; -M: ship tick ( actor -- ? ) dup [ move ] bind active? ;M +M: ship tick ( actor -- ? ) dup [ move ] bind active? ; -: make-ship ( -- ship ) - [ +C: ship ( -- ship ) + [ width get 2 /i height get 50 - rect> position set white color set 10 radius set 0 velocity set active on - ] extend unit ; + ] extend ; ! Projectiles TRAITS: plasma @@ -135,17 +134,17 @@ M: plasma draw ( actor -- ) [ surface get screen-xy dup len get + color get vlineColor - ] bind ;M + ] bind ; M: plasma tick ( actor -- ? ) - dup [ move ] bind dup in-screen? swap active? and ;M + dup [ move ] bind dup in-screen? swap active? and ; M: plasma collide ( actor1 actor2 -- ) #! Remove the other actor. - deactivate deactivate ;M + deactivate deactivate ; -: make-plasma ( actor dy -- plasma ) - [ +C: plasma ( actor dy -- plasma ) + [ velocity set actor-xy blue color set @@ -157,17 +156,17 @@ M: plasma collide ( actor1 actor2 -- ) : player-fire ( -- ) #! Do nothing if player is dead. player-actor [ - #{ 0 -6 } make-plasma player-shots cons@ + #{ 0 -6 } player-shots cons@ ] when* ; : enemy-fire ( actor -- ) - #{ 0 5 } make-plasma enemy-shots cons@ ; + #{ 0 5 } enemy-shots cons@ ; ! Background of stars TRAITS: particle M: particle draw ( actor -- ) - [ surface get screen-xy color get pixelColor ] bind ;M + [ surface get screen-xy color get pixelColor ] bind ; : wrap ( -- ) #! If current actor has gone beyond screen bounds, move it @@ -178,7 +177,9 @@ M: particle draw ( actor -- ) rect> position set ; M: particle tick ( actor -- ) - [ move wrap t ] bind ;M + [ move wrap t ] bind ; + +C: particle ; SYMBOL: stars : star-count 100 ; @@ -216,7 +217,7 @@ M: enemy draw ( actor -- ) [ surface get screen-xy radius get color get filledCircleColor - ] bind ;M + ] bind ; : attack-chance 30 ; @@ -239,7 +240,9 @@ SYMBOL: wiggle-x M: enemy tick ( actor -- ) dup attack dup [ wiggle move position get imaginary ] bind - y-in-screen? swap active? and ;M + y-in-screen? swap active? and ; + +C: enemy ; : spawn-enemy ( -- ) [ @@ -289,7 +292,7 @@ SYMBOL: event : init-game ( -- ) #! Init game objects. init-stars - make-ship player set + unit player set event set ; : each-layer ( quot -- ) diff --git a/examples/mandel.factor b/examples/mandel.factor index 121b3c50a4..3d472591ec 100644 --- a/examples/mandel.factor +++ b/examples/mandel.factor @@ -8,7 +8,7 @@ ! "examples/mandel.factor" run-file IN: mandel - +USE: compiler USE: alien USE: errors USE: kernel @@ -43,14 +43,14 @@ USE: test ] times* ] make-list list>vector nip ; -: absq >rect swap sq swap sq + ; +: absq >rect swap sq swap sq + ; inline : iter ( c z nb-iter -- x ) over absq 4 >= over 0 = or [ nip nip ] [ pred >r sq dupd + r> iter - ] ifte ; + ] ifte ; compiled : max-color 360 ; @@ -71,7 +71,7 @@ SYMBOL: center x-inc get * center get real x-inc get width get 2 / * - + >float r> y-inc get * center get imaginary y-inc get height get 2 / * - + >float - rect> ; + rect> ; compiled : render ( -- ) init-mandel diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index a1ff857d30..1ab3b31c41 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -34,7 +34,12 @@ USE: stdio "Cold boot in progress..." print [ - "/version.factor" + "/library/generic/generic.factor" + "/library/generic/object.factor" + "/library/generic/builtin.factor" + "/library/generic/predicate.factor" + "/library/generic/traits.factor" + "/version.factor" "/library/stack.factor" "/library/combinators.factor" @@ -57,11 +62,6 @@ USE: stdio "/library/errors.factor" "/library/continuations.factor" "/library/threads.factor" - "/library/generic/generic.factor" - "/library/generic/object.factor" - "/library/generic/builtin.factor" - "/library/generic/predicate.factor" - "/library/generic/traits.factor" "/library/io/stream.factor" "/library/io/stdio.factor" "/library/io/io-internals.factor" @@ -71,7 +71,7 @@ USE: stdio "/library/syntax/parser.factor" "/library/syntax/parse-stream.factor" "/library/bootstrap/init.factor" - "/library/syntax/parse-syntax.factor" +! "/library/syntax/parse-syntax.factor" "/library/format.factor" "/library/syntax/unparser.factor" diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor index f8efb60347..1356dd0487 100644 --- a/library/bootstrap/init-stage2.factor +++ b/library/bootstrap/init-stage2.factor @@ -25,12 +25,12 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -IN: init +IN: kernel USE: ansi USE: compiler USE: errors USE: inference -USE: kernel +USE: command-line USE: listener USE: lists USE: math @@ -75,7 +75,7 @@ USE: unparser warm-boot garbage-collection "interactive" get [ print-banner listener ] when - 0 exit* + 0 exit* ] set-boot init-error-handler diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor index dcc6f128c3..b5c2700104 100644 --- a/library/bootstrap/init.factor +++ b/library/bootstrap/init.factor @@ -25,8 +25,7 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -IN: init -USE: kernel +IN: kernel USE: namespaces USE: parser USE: stdio diff --git a/library/cli.factor b/library/cli.factor index 9c6cc95dcd..9165d2b142 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -25,7 +25,7 @@ ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -IN: init +IN: command-line USE: compiler USE: errors USE: files diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index 384316ec8d..90f7a8cde6 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -41,7 +41,16 @@ USE: unparser USE: vectors USE: words +: supported-cpu? ( -- ? ) + cpu "unknown" = not ; + +: check-architecture ( -- ) + supported-cpu? [ + "Unsupported CPU; compiler disabled" throw + ] unless ; + : compiling ( word -- definition ) + check-architecture "verbose-compile" get [ "Compiling " write dup . flush ] when @@ -67,7 +76,7 @@ USE: words : compiled ( -- ) #! Compile the most recently defined word. - word compile ; parsing + "compile" get [ word compile ] when ; parsing : cannot-compile ( word -- ) "verbose-compile" get [ @@ -81,10 +90,4 @@ USE: words : compile-all ( -- ) #! Compile all words. - [ - ! dup "infer-effect" word-property [ - try-compile - ! ] [ - ! drop - ! ] ifte - ] each-word ; + [ try-compile ] each-word ; diff --git a/library/hashtables.factor b/library/hashtables.factor index 63238063be..2e69bc2472 100644 --- a/library/hashtables.factor +++ b/library/hashtables.factor @@ -61,13 +61,20 @@ PREDICATE: vector hashtable ( obj -- ? ) #! undefined value, or a value set to f. hash* dup [ cdr ] when ; -: set-hash ( value key table -- ) +: set-hash* ( key table quot -- ) + #! Apply the quotation to yield a new association list. + over >r -rot dupd (hashcode) r> vector-nth swap call ; + inline + +! : set-hash ( value key table -- ) #! Store the value in the hashtable. Either replaces an #! existing value in the appropriate bucket, or adds a new - #! key/value pair, - dup >r 2dup (hashcode) dup >r swap - vector-nth set-assoc - r> r> set-vector-nth ; + #! key/value pair. +! [ set-assoc ] set-hash* ; + +: remove-hash ( key table -- ) + #! Remove a value from a hashtable. + [ remove-assoc ] set-hash* ; : hash-each ( hash code -- ) #! Apply the code to each key/value pair of the hashtable. diff --git a/library/test/benchmark/sort.factor b/library/test/benchmark/sort.factor index 264583f1b3..55a8c9ae30 100644 --- a/library/test/benchmark/sort.factor +++ b/library/test/benchmark/sort.factor @@ -4,5 +4,9 @@ USE: kernel USE: math USE: random USE: test +USE: compiler -[ ] [ [ 100000 [ 0 10000 random-int , ] times ] make-list [ > ] sort drop ] unit-test +: sort-benchmark + [ 100000 [ 0 10000 random-int , ] times ] make-list [ > ] sort drop ; compiled + +[ ] [ sort-benchmark ] unit-test diff --git a/library/test/hashtables.factor b/library/test/hashtables.factor index 3f76647c60..d0cf97e16c 100644 --- a/library/test/hashtables.factor +++ b/library/test/hashtables.factor @@ -46,3 +46,15 @@ f 100 fac "testhash" get set-hash [ t ] [ #{ 2 3 } "testhash" get hash ] unit-test [ f ] [ 100 fac "testhash" get hash* cdr ] unit-test [ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test + +[ + [ "salmon" | "fish" ] + [ "crocodile" | "reptile" ] + [ "cow" | "mammal" ] + [ "visual basic" | "language" ] +] alist>hash "testhash" set + +[ f ] [ + "visual basic" "testhash" get remove-hash + "visual basic" "testhash" get hash* +] unit-test diff --git a/library/test/init.factor b/library/test/init.factor index 564cb13ee8..9df05858d6 100644 --- a/library/test/init.factor +++ b/library/test/init.factor @@ -1,5 +1,5 @@ IN: scratchpad -USE: init +USE: command-line USE: namespaces USE: test diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor index 541598e89a..dab1671edc 100644 --- a/library/tools/interpreter.factor +++ b/library/tools/interpreter.factor @@ -106,6 +106,16 @@ SYMBOL: meta-cf : do ( obj -- ) dup word? [ meta-word ] [ push-d ] ifte ; +: meta-word-1 ( word -- ) + dup "meta-word" word-property dup [ + nip call + ] [ + drop host-word + ] ifte ; + +: do-1 ( obj -- ) + dup word? [ meta-word-1 ] [ push-d ] ifte ; + : (interpret) ( quot -- ) #! The quotation is called with each word as its executed. done? [ drop ] [ [ next swap call ] keep (interpret) ] ifte ; @@ -182,6 +192,10 @@ SYMBOL: meta-cf done? [ "Stepper is done." print drop ] [ call ] ifte ; : step + #! Step into current word. + [ next dup report do-1 ] not-done ; + +: into #! Step into current word. [ next dup report do ] not-done ; @@ -191,7 +205,8 @@ SYMBOL: meta-cf "show stepper stacks." print \ &get prettyprint-1 " ( var -- value ) inspects the stepper namestack." print - \ step prettyprint-1 " -- single step" print + \ step prettyprint-1 " -- single step over" print + \ into prettyprint-1 " -- single step into" print \ (trace) prettyprint-1 " -- trace until end" print \ (run) prettyprint-1 " -- run until end" print \ exit prettyprint-1 " -- exit single-stepper" print ;