[pure-lang-svn] SF.net SVN: pure-lang:[816] pure/trunk

[<ag...@us...>]

Revision: 816
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=816&view=rev
Author:   agraef
Date:     2008-09-21 07:44:02 +0000 (Sun, 21 Sep 2008)

Log Message:
-----------
Experimental support for marshalling complex numbers (this doesn't work right now, and so is disabled).

Modified Paths:
--------------
    pure/trunk/interpreter.cc
    pure/trunk/interpreter.hh
    pure/trunk/runtime.cc
    pure/trunk/runtime.h

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-09-21 05:29:14 UTC (rev 815)
+++ pure/trunk/interpreter.cc	2008-09-21 07:44:02 UTC (rev 816)
@@ -133,8 +133,7 @@
   // Complex numbers (complex double).
   {
     std::vector<const Type*> elts;
-    elts.push_back(Type::DoubleTy);
-    elts.push_back(Type::DoubleTy);
+    elts.push_back(ArrayType::get(Type::DoubleTy, 2));
     ComplexTy = StructType::get(elts);
     ComplexPtrTy = PointerType::get(ComplexTy, 0);
   }
@@ -376,6 +375,16 @@
   declare_extern((void*)pure_get_matrix,
 		 "pure_get_matrix",  "void*", 1, "expr*");
 
+#if COMPLEX_NUMBERS
+  /* Marshalling of complex numbers. This doesn't work yet and is disabled. */
+  declare_extern((void*)pure_complex,
+		 "pure_complex",    "expr*",  1, "complex");
+  declare_extern((void*)pure_is_complex,
+		 "pure_is_complex", "bool",   1, "expr*");
+  declare_extern((void*)pure_get_complex,
+		 "pure_get_complex", "complex", 1, "expr*");
+#endif
+
   declare_extern((void*)pure_catch,
 		 "pure_catch",      "expr*",  2, "expr*", "expr*");
   declare_extern((void*)pure_throw,
@@ -3664,7 +3673,7 @@
     return Type::FloatTy;
   else if (name == "double")
     return Type::DoubleTy;
-#if 0 // no marshalling available yet, does LLVM support these?
+#if COMPLEX_NUMBERS
   else if (name == "complex")
     return ComplexTy;
 #endif
@@ -3678,7 +3687,7 @@
     return PointerType::get(Type::Int64Ty, 0);
   else if (name == "double*")
     return PointerType::get(Type::DoubleTy, 0);
-#if 0
+#if COMPLEX_NUMBERS
   else if (name == "complex*")
     return ComplexPtrTy;
 #endif
@@ -3721,8 +3730,10 @@
     return "float";
   else if (type == Type::DoubleTy)
     return "double";
+#if COMPLEX_NUMBERS
   else if (type == ComplexTy)
     return "complex";
+#endif
   else if (type == CharPtrTy)
     return "char*";
   else if (type == PointerType::get(Type::Int16Ty, 0))
@@ -3733,8 +3744,10 @@
     return "long*";
   else if (type == PointerType::get(Type::DoubleTy, 0))
     return "double*";
+#if COMPLEX_NUMBERS
   else if (type == ComplexPtrTy)
     return "complex*";
+#endif
   else if (type == ExprPtrTy)
     return "expr*";
   else if (type == ExprPtrPtrTy)
@@ -4080,6 +4093,19 @@
       idx[1] = ValFldIndex;
       Value *dv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "dblval");
       unboxed[i] = dv;
+#if COMPLEX_NUMBERS
+    } else if (argt[i] == ComplexTy) {
+      BasicBlock *okbb = BasicBlock::Create("ok");
+      // Pure's complex values are a special algebraic data type defined in
+      // math.pure, hence we have to go to some lengths here to get these
+      // values.
+      Value *chk = b.CreateCall(module->getFunction("pure_is_complex"), x);
+      b.CreateCondBr(chk, okbb, failedbb);
+      f->getBasicBlockList().push_back(okbb);
+      b.SetInsertPoint(okbb);
+      Value *cv = b.CreateCall(module->getFunction("pure_get_complex"), x);
+      unboxed[i] = cv;
+#endif
     } else if (argt[i] == CharPtrTy) {
       BasicBlock *okbb = BasicBlock::Create("ok");
       Value *idx[2] = { Zero, Zero };
@@ -4094,7 +4120,11 @@
 	       argt[i] == PointerType::get(Type::Int32Ty, 0) ||
 	       argt[i] == PointerType::get(Type::Int64Ty, 0) ||
 	       argt[i] == PointerType::get(Type::FloatTy, 0) ||
-	       argt[i] == PointerType::get(Type::DoubleTy, 0)) {
+	       argt[i] == PointerType::get(Type::DoubleTy, 0)
+#if COMPLEX_NUMBERS
+	       || argt[i] == ComplexPtrTy
+#endif
+	       ) {
       BasicBlock *okbb = BasicBlock::Create("ok");
       Value *idx[2] = { Zero, Zero };
       Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
@@ -4200,13 +4230,21 @@
 		     b.CreateFPExt(u, Type::DoubleTy));
   else if (type == Type::DoubleTy)
     u = b.CreateCall(module->getFunction("pure_double"), u);
+#if COMPLEX_NUMBERS
+  else if (type == ComplexTy)
+    u = b.CreateCall(module->getFunction("pure_complex"), u);
+#endif
   else if (type == CharPtrTy)
     u = b.CreateCall(module->getFunction("pure_cstring_dup"), u);
   else if (type == PointerType::get(Type::Int16Ty, 0) ||
 	   type == PointerType::get(Type::Int32Ty, 0) ||
 	   type == PointerType::get(Type::Int64Ty, 0) ||
 	   type == PointerType::get(Type::FloatTy, 0) ||
-	   type == PointerType::get(Type::DoubleTy, 0))
+	   type == PointerType::get(Type::DoubleTy, 0)
+#if COMPLEX_NUMBERS
+	   || type == ComplexPtrTy
+#endif
+	   )
     u = b.CreateCall(module->getFunction("pure_pointer"),
 		     b.CreateBitCast(u, VoidPtrTy));
   else if (type == GSLMatrixPtrTy)

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-09-21 05:29:14 UTC (rev 815)
+++ pure/trunk/interpreter.hh	2008-09-21 07:44:02 UTC (rev 816)
@@ -41,6 +41,13 @@
    default, use 0 to disable this option). */
 #define LIST_KLUDGE 10
 
+/* Experimental support for marshalling of complex numbers in the C
+   interface. This doesn't work right now and is disabled. LLVM doesn't seem
+   to provide a transparent way to handle complex values in function calls
+   yet, and maybe this isn't even possible because different compilers might
+   specify different ABIs to do that kind of thing. */
+#define COMPLEX_NUMBERS 0
+
 using namespace std;
 
 /* The Pure interpreter. */

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-09-21 05:29:14 UTC (rev 815)
+++ pure/trunk/runtime.cc	2008-09-21 07:44:02 UTC (rev 816)
@@ -890,6 +890,28 @@
 #endif
 }
 
+static inline bool is_complex(pure_expr *x)
+{
+  if (x->tag != EXPR::APP) return false;
+  pure_expr *u = x->data.x[0], *v = x->data.x[1];
+  if (u->tag == EXPR::APP) {
+    interpreter& interp = *interpreter::g_interp;
+    pure_expr *f = u->data.x[0];
+    symbol *rect = interp.symtab.complex_rect_sym(),
+      *polar = interp.symtab.complex_polar_sym();
+    if ((!rect || f->tag != rect->f) &&
+	(!polar || f->tag != polar->f))
+      return false;
+    u = u->data.x[1];
+    if (u->tag != EXPR::INT && u->tag != EXPR::DBL ||
+	v->tag != EXPR::INT && v->tag != EXPR::DBL)
+      return false;
+    else
+      return true;
+  } else
+    return false;
+}
+
 static inline bool get_complex(pure_expr *x, double& a, double& b)
 {
   if (x->tag != EXPR::APP) return false;
@@ -2521,7 +2543,33 @@
   return &x->data.z;
 }
 
+#if COMPLEX_NUMBERS
 extern "C"
+pure_expr *pure_complex(__complex_double c)
+{
+  return make_complex(c.x[0], c.x[1]);
+}
+
+extern "C"
+bool pure_is_complex(pure_expr *x)
+{
+  return is_complex(x);
+}
+
+extern "C"
+__complex_double pure_get_complex(pure_expr *x)
+{
+  __complex_double res = {{0.0,0.0}};
+  double a, b;
+  if (get_complex(x, a, b)) {
+    res.x[0] = a;
+    res.x[1] = b;
+  }
+  return res;
+}
+#endif
+
+extern "C"
 void *pure_get_matrix(pure_expr *x)
 {
   assert(x && x->tag == EXPR::MATRIX || x->tag == EXPR::DMATRIX ||

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-09-21 05:29:14 UTC (rev 815)
+++ pure/trunk/runtime.h	2008-09-21 07:44:02 UTC (rev 816)
@@ -438,6 +438,21 @@
 int64_t pure_get_long(pure_expr *x);
 int32_t pure_get_int(pure_expr *x);
 
+#if 0
+// This stuff is disabled right now as it doesn't work yet.
+/* Marshall complex numbers. These are actually defined as an algebraic type
+   in math.pure, but we need some basic support for these values in the C
+   interface. */
+
+/* We don't want to rely on ISO complex number support here. The following
+   should do the job on all supported systems. */
+typedef struct { double x[2]; } __complex_double;
+
+pure_expr *pure_complex(__complex_double c);
+bool pure_is_complex(pure_expr *x);
+__complex_double pure_get_complex(pure_expr *x);
+#endif
+
 /* Convert a matrix expression to a pointer to the corresponding GSL matrix
    struct. This is used to marshall matrix arguments in the C interface. */
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.