compiled stack ops didn't commit-literals; printing gensym with a def failed

cvs
Slava Pestov 2004-11-10 03:19:43 +00:00
parent 2f1039eb05
commit fd4259657c
6 changed files with 34 additions and 9 deletions

View File

@ -205,6 +205,7 @@ SYMBOL: stars
] extend ; ] extend ;
: init-stars ( -- ) : init-stars ( -- )
#! Generate random background of scrolling stars.
[ ] star-count [ random-star swons ] times stars set ; [ ] star-count [ random-star swons ] times stars set ;
: draw-stars ( -- ) : draw-stars ( -- )

View File

@ -161,19 +161,21 @@ DEFER: prettyprint*
] ; ] ;
: word-attrs ( word -- attrs ) : word-attrs ( word -- attrs )
dup defined? [ #! Words without a vocabulary do not get a link or an action
dup >r #! popup.
word-link dup >r "object-link" swons r> dup word-vocabulary [
word-link [ "object-link" swons ] keep
word-actions <actions> "actions" swons word-actions <actions> "actions" swons
t "underline" swons t "underline" swons
3list 3list
r>
] [ ] [
[ ] swap drop [ ]
] ifte word-style append ; ] ifte ;
: prettyprint-word ( word -- ) : prettyprint-word ( word -- )
dup word-name swap word-attrs write-attr ; dup word-name
swap dup word-attrs swap word-style append
write-attr ;
: prettyprint-object ( indent obj -- indent ) : prettyprint-object ( indent obj -- indent )
unparse write ; unparse write ;

View File

@ -11,5 +11,5 @@ USE: math
[ 2 ] [ 5 "x" /@ "x" get ] unit-test [ 2 ] [ 5 "x" /@ "x" get ] unit-test
[ 1 ] [ "x" pred@ "x" get ] unit-test [ 1 ] [ "x" pred@ "x" get ] unit-test
[ 2 ] [ "x" succ@ "x" get ] unit-test [ 2 ] [ "x" succ@ "x" get ] unit-test
[ 7 ] [ -3 "x" set 10 "x" rem@ ] unit-test [ 7 ] [ -3 "x" set 10 "x" rem@ "x" get ] unit-test
[ -3 ] [ -3 "x" set 10 "x" rem@ ] unit-test [ -3 ] [ -3 "x" set 10 "x" mod@ "x" get ] unit-test

View File

@ -3,5 +3,7 @@ USE: lists
USE: prettyprint USE: prettyprint
USE: test USE: test
USE: words USE: words
USE: stack
[ ] [ gensym dup [ ] define-compound . ] unit-test
[ ] [ vocabs [ words [ see ] each ] each ] unit-test [ ] [ vocabs [ words [ see ] each ] each ] unit-test

View File

@ -120,6 +120,7 @@ USE: unparser
cpu "x86" = [ cpu "x86" = [
[ [
"x86-compiler/simple" "x86-compiler/simple"
"x86-compiler/stack"
"x86-compiler/ifte" "x86-compiler/ifte"
"x86-compiler/generic" "x86-compiler/generic"
"x86-compiler/bail-out" "x86-compiler/bail-out"

View File

@ -0,0 +1,19 @@
IN: scratchpad
USE: compiler
USE: test
USE: stack
USE: words
USE: combinators
USE: lists
! Make sure that stack ops compile to correct code.
: compile-call ( quot -- word )
gensym [ swap define-compound ] keep dup compile execute ;
[ ] [ 1 [ drop ] compile-call ] unit-test
[ ] [ [ 1 drop ] compile-call ] unit-test
[ ] [ [ 1 2 2drop ] compile-call ] unit-test
[ ] [ 1 [ 2 2drop ] compile-call ] unit-test
[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
[ 1 1 ] [ [ 1 dup ] compile-call ] unit-test