From e11d1e37f5b1c3fa8cc245cb9ae49e80c2fb8d98 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 4 Sep 2009 02:35:58 -0500
Subject: [PATCH] math.vectors.simd: allow punning SIMD vectors between types

---
 .../cfg/representations/representations.factor      | 13 +++++++++----
 basis/math/vectors/simd/simd-tests.factor           | 11 +++++++++++
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index 6fe28caf81..ec2856f647 100644
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/basis/compiler/cfg/representations/representations.factor
@@ -51,10 +51,15 @@ M: vector-rep emit-unbox
         { [ dup int-rep eq? ] [ drop emit-unbox ] }
         { [ over int-rep eq? ] [ nip emit-box ] }
         [
-            2array {
-                { { double-rep float-rep } [ ##single>double-float ] }
-                { { float-rep double-rep } [ ##double>single-float ] }
-                [ first2 bad-conversion ]
+            2dup 2array {
+                { { double-rep float-rep } [ 2drop ##single>double-float ] }
+                { { float-rep double-rep } [ 2drop ##double>single-float ] }
+                ! Punning SIMD vector types? Naughty naughty! But
+                ! it is allowed... otherwise bail out.
+                [
+                    drop 2dup [ reg-class-of ] bi@ eq?
+                    [ drop ##copy ] [ bad-conversion ] if
+                ]
             } case
         ]
     } cond ;
diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor
index 532ec84764..e847fcad74 100644
--- a/basis/math/vectors/simd/simd-tests.factor
+++ b/basis/math/vectors/simd/simd-tests.factor
@@ -348,3 +348,14 @@ tools.test compiler.tree.debugger accessors kernel ;
     -2.0
     [ { float-8 float } declare v/n ] compile-call
 ] unit-test
+
+! Test puns
+[ double-2{ 4 1024 } ] [
+    float-4{ 0 1 0 2 }
+    [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
+] unit-test
+
+[ 33.0 ] [
+    double-2{ 1 2 } double-2{ 10 20 }
+    [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
+] unit-test