+ linearizer/generator:\r
\r
- peephole optimizer\r
-- tail call optimization\r
- getenv/setenv: if literal arg, compile as a load/store\r
- compiler: drop literal peephole optimization\r
\r
\r
+ ffi:\r
\r
-- port ffi to new compiler\r
- is signed -vs- unsigned pointers an issue?\r
- bitfields in C structs\r
- SDL_Rect** type\r
\r
+ misc:\r
\r
-- some way to step over a word in the stepper\r
- step: print NEXT word to execute, not word that JUST executed\r
- perhaps /i should work with all numbers\r
- unit test weirdness: 2 lines appears at end\r
!
! ./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
USE: logic
USE: math
USE: namespaces
-USE: oop
+USE: generic
USE: random
USE: sdl
USE: sdl-event
[
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 )
- <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
[
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 )
- <plasma> [
+C: plasma ( actor dy -- plasma )
+ [
velocity set
actor-xy
blue color set
: player-fire ( -- )
#! Do nothing if player is dead.
player-actor [
- #{ 0 -6 } make-plasma player-shots cons@
+ #{ 0 -6 } <plasma> player-shots cons@
] when* ;
: enemy-fire ( actor -- )
- #{ 0 5 } make-plasma enemy-shots cons@ ;
+ #{ 0 5 } <plasma> 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
rect> position set ;
M: particle tick ( actor -- )
- [ move wrap t ] bind ;M
+ [ move wrap t ] bind ;
+
+C: particle ;
SYMBOL: stars
: star-count 100 ;
[
surface get screen-xy radius get color get
filledCircleColor
- ] bind ;M
+ ] bind ;
: attack-chance 30 ;
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 ( -- )
<enemy> [
: init-game ( -- )
#! Init game objects.
init-stars
- make-ship player set
+ <ship> unit player set
<event> event set ;
: each-layer ( quot -- )
! "examples/mandel.factor" run-file
IN: mandel
-
+USE: compiler
USE: alien
USE: errors
USE: kernel
] 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 ;
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
"Cold boot in progress..." print\r
\r
[\r
- "/version.factor"\r
+ "/library/generic/generic.factor"\r
+ "/library/generic/object.factor"\r
+ "/library/generic/builtin.factor"\r
+ "/library/generic/predicate.factor"\r
+ "/library/generic/traits.factor"\r
+\r
"/version.factor"\r
"/library/stack.factor"\r
"/library/combinators.factor"\r
"/library/errors.factor"\r
"/library/continuations.factor"\r
"/library/threads.factor"\r
- "/library/generic/generic.factor"\r
- "/library/generic/object.factor"\r
- "/library/generic/builtin.factor"\r
- "/library/generic/predicate.factor"\r
- "/library/generic/traits.factor"\r
"/library/io/stream.factor"\r
"/library/io/stdio.factor"\r
"/library/io/io-internals.factor"\r
"/library/syntax/parser.factor"\r
"/library/syntax/parse-stream.factor"\r
"/library/bootstrap/init.factor"\r
- "/library/syntax/parse-syntax.factor"\r
+! "/library/syntax/parse-syntax.factor"\r
\r
"/library/format.factor"\r
"/library/syntax/unparser.factor"\r
! 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
warm-boot
garbage-collection
"interactive" get [ print-banner listener ] when
- 0 exit*
+ 0 exit*
] set-boot
init-error-handler
! 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
! 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
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
: compiled ( -- )
#! Compile the most recently defined word.
- word compile ; parsing
+ "compile" get [ word compile ] when ; parsing
: cannot-compile ( word -- )
"verbose-compile" get [
: compile-all ( -- )
#! Compile all words.
- [
- ! dup "infer-effect" word-property [
- try-compile
- ! ] [
- ! drop
- ! ] ifte
- ] each-word ;
+ [ try-compile ] each-word ;
#! 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.
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
[ 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
IN: scratchpad
-USE: init
+USE: command-line
USE: namespaces
USE: test
: 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 ;
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 ;
"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 ;
projects / factor.git / commitdiff