compiled stack ops didn't commit-literals; printing gensym with a def failed
parent
2f1039eb05
commit
fd4259657c
|
@ -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 ( -- )
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue