From f4b4195a742575cea794ab854cfbf494fdfb7535 Mon Sep 17 00:00:00 2001
From: Sascha Matzke <sascha.matzke@didolo.org>
Date: Sat, 11 Jul 2009 11:14:17 +0200
Subject: [PATCH 1/2] added unit-tests to bson vocab
---
extra/bson/bson-tests.factor | 48 ++++++++++++++++++++++++++++++++++++
1 file changed, 48 insertions(+)
create mode 100644 extra/bson/bson-tests.factor
diff --git a/extra/bson/bson-tests.factor b/extra/bson/bson-tests.factor
new file mode 100644
index 0000000000..e66b9c6ec2
--- /dev/null
+++ b/extra/bson/bson-tests.factor
@@ -0,0 +1,48 @@
+USING: bson.reader bson.writer byte-arrays io.encodings.binary
+io.streams.byte-array tools.test literals calendar kernel math ;
+
+IN: bson.tests
+
+: turnaround ( value -- value )
+ assoc>bv >byte-array binary [ H{ } stream>assoc ] with-byte-reader ;
+
+M: timestamp equal? ( obj1 obj2 -- ? )
+ [ timestamp>millis ] bi@ = ;
+
+[ H{ { "a" "a string" } } ] [ H{ { "a" "a string" } } turnaround ] unit-test
+
+[ H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } ]
+[ H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } turnaround ] unit-test
+
+[ H{ { "a list" { 1 2.234 "hello world" } } } ]
+[ H{ { "a list" { 1 2.234 "hello world" } } } turnaround ] unit-test
+
+[ H{ { "a quotation" [ 1 2 + ] } } ]
+[ H{ { "a quotation" [ 1 2 + ] } } turnaround ] unit-test
+
+[ H{ { "a date" T{ timestamp { year 2009 }
+ { month 7 }
+ { day 11 }
+ { hour 11 }
+ { minute 8 }
+ { second 40+15437/200000 }
+ { gmt-offset T{ duration { hour 2 } } } } } }
+]
+[ H{ { "a date" T{ timestamp { year 2009 }
+ { month 7 }
+ { day 11 }
+ { hour 11 }
+ { minute 8 }
+ { second 40+15437/200000 }
+ { gmt-offset T{ duration { hour 2 } } } } } } turnaround
+] unit-test
+
+[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
+ { "array" H{ { "a list" { 1 2.234 "hello world" } } } }
+ { "quot" [ 1 2 + ] } }
+]
+[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
+ { "array" H{ { "a list" { 1 2.234 "hello world" } } } }
+ { "quot" [ 1 2 + ] } } turnaround ] unit-test
+
+
From ccae9b59a4e69b17b2a011313a5050d524920d8e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 13 Jul 2009 19:02:05 -0500
Subject: [PATCH 2/2] clean up value numbering conversion of ##add/sub to
##add/sub-imm
---
.../value-numbering/rewrite/rewrite.factor | 28 ++++++++++++-------
1 file changed, 18 insertions(+), 10 deletions(-)
diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index 92965e40c5..988df366eb 100755
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -49,9 +49,12 @@ M: insn rewrite ;
[ src2>> tag-mask get bitand 0 = ]
} 1&& ; inline
+: tagged>constant ( n -- n' )
+ tag-bits get neg shift ; inline
+
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
[ src1>> vreg>expr in1>> vn>vreg ]
- [ src2>> tag-bits get neg shift ]
+ [ src2>> tagged>constant ]
[ cc>> ]
tri ; inline
@@ -203,15 +206,20 @@ M: ##or-imm rewrite [ bitor ] \ ##or-imm combine-imm ;
M: ##xor-imm rewrite [ bitxor ] \ ##xor-imm combine-imm ;
-: rewrite-add? ( insn -- ? )
- src2>> vreg-small-constant? ;
-
-M: ##add rewrite
- dup rewrite-add? [
+: new-arithmetic ( obj op -- )
+ [
[ dst>> ]
[ src1>> ]
- [ src2>> vreg>constant ] tri \ ##add-imm new-insn
- dup number-values
- ] when ;
+ [ src2>> vreg>constant ] tri
+ ] dip new-insn dup number-values ; inline
-M: ##sub rewrite constant-fold ;
+: rewrite-arithmetic ( insn op -- ? )
+ over src2>> vreg-small-constant? [
+ new-arithmetic constant-fold
+ ] [
+ drop
+ ] if ; inline
+
+M: ##add rewrite \ ##add-imm rewrite-arithmetic ;
+
+M: ##sub rewrite \ ##sub-imm rewrite-arithmetic ;