]> gitweb.factorcode.org Git - factor.git/commitdiff
compiled stack ops didn't commit-literals; printing gensym with a def failed
authorSlava Pestov <slava@factorcode.org>
Wed, 10 Nov 2004 03:19:43 +0000 (03:19 +0000)
committerSlava Pestov <slava@factorcode.org>
Wed, 10 Nov 2004 03:19:43 +0000 (03:19 +0000)
examples/factoroids.factor
library/prettyprint.factor
library/test/math/namespaces.factor
library/test/prettyprint.factor
library/test/test.factor
library/test/x86-compiler/stack.factor [new file with mode: 0644]

index bb4384eb8412e37092d4fb2eb4f91f9ec472e21a..b2ca0ee43d50f09f5ab14f7a16bfa92b0bd0578c 100644 (file)
@@ -205,6 +205,7 @@ SYMBOL: stars
     ] extend ;
 
 : init-stars ( -- )
+    #! Generate random background of scrolling stars.
     [ ] star-count [ random-star swons ] times stars set ;
 
 : draw-stars ( -- )
index f916bce40996b91a515eb971f91d7faf3d1a9a99..b5aba002dafc384d3c47df585641bb73123512b2 100644 (file)
@@ -161,19 +161,21 @@ DEFER: prettyprint*
     ] ;
 
 : word-attrs ( word -- attrs )
-    dup defined? [
-        dup >r
-        word-link dup >r "object-link" swons r>
+    #! Words without a vocabulary do not get a link or an action
+    #! popup.
+    dup word-vocabulary [
+        word-link [ "object-link" swons ] keep
         word-actions <actions> "actions" swons
         t "underline" swons
         3list
-        r>
     ] [
-        [ ] swap
-    ] ifte word-style append ;
+        drop [ ]
+    ] ifte ;
 
 : 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 )
     unparse write ;
index 5bfebc4a3cf3c81c62786d1ee6b2f5f7c4db481d..64b56ba1a2118d40734319c4e983bee1bdafbf07 100644 (file)
@@ -11,5 +11,5 @@ USE: math
 [ 2 ] [ 5 "x" /@ "x" get ] unit-test
 [ 1 ] [ "x" pred@ "x" get ] unit-test
 [ 2 ] [ "x" succ@ "x" get ] unit-test
-[ 7 ] [ -3 "x" set 10 "x" rem@ ] unit-test 
-[ -3 ] [ -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" mod@ "x" get ] unit-test 
index 0fa8751ba9e1f5e6c64a003f1cad4d7e5318ba63..edd03f1a41a24854d3ff166986c4dc8f8e373da7 100644 (file)
@@ -3,5 +3,7 @@ USE: lists
 USE: prettyprint
 USE: test
 USE: words
+USE: stack
 
+[ ] [ gensym dup [ ] define-compound . ] unit-test
 [ ] [ vocabs [ words [ see ] each ] each ] unit-test
index 80790e3a7ac6e69e7fc03bd7c4b02ecda83a1446..250afaa91be192dc02d86b4d0e850f9357dcbcfe 100644 (file)
@@ -120,6 +120,7 @@ USE: unparser
         cpu "x86" = [
             [
                 "x86-compiler/simple"
+                "x86-compiler/stack"
                 "x86-compiler/ifte"
                 "x86-compiler/generic"
                 "x86-compiler/bail-out"
diff --git a/library/test/x86-compiler/stack.factor b/library/test/x86-compiler/stack.factor
new file mode 100644 (file)
index 0000000..d40625c
--- /dev/null
@@ -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