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

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

Revision: 811
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=811&view=rev
Author:   agraef
Date:     2008-09-20 18:50:23 +0000 (Sat, 20 Sep 2008)

Log Message:
-----------
Get rid of the pair representation for complex values in GSL matrices, as it interferes with symbolic matrices containing pairs.

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

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-09-20 17:56:26 UTC (rev 810)
+++ pure/trunk/interpreter.cc	2008-09-20 18:50:23 UTC (rev 811)
@@ -928,8 +928,8 @@
     if (x->data.mat.p) {
       gsl_matrix_complex *m = (gsl_matrix_complex*)x->data.mat.p;
       exprll *xs = new exprll;
-      symbol *rect = symtab.complex_rect_sym();
-      expr f = rect?rect->x:symtab.pair_sym().x;
+      symbol *rect = symtab.complex_rect_sym(true);
+      expr f = rect->x;
       for (size_t i = 0; i < m->size1; i++) {
 	xs->push_back(exprl());
 	exprl& ys = xs->back();

Modified: pure/trunk/printer.cc
===================================================================
--- pure/trunk/printer.cc	2008-09-20 17:56:26 UTC (rev 810)
+++ pure/trunk/printer.cc	2008-09-20 18:50:23 UTC (rev 811)
@@ -817,38 +817,25 @@
     }
     return os << "}";
   case EXPR::CMATRIX:
+    /* Print complex values in rectangular format using the infix notation
+       defined in math.pure. FIXME: We require the +: symbol to be predefined
+       no matter whether math.pure has actually been loaded. */
     os << "{";
     if (x->data.mat.p) {
+      interpreter& interp = *interpreter::g_interp;
+      symbol *rect = interp.symtab.complex_rect_sym(true);
+      string& rectsym = rect->s;
       gsl_matrix_complex *m = (gsl_matrix_complex*)x->data.mat.p;
       if (m->size1>0 && m->size2>0) {
-	/* GSL represents complex matrices using pairs of double values, while
-	   Pure provides its own complex type in math.pure. If math.pure has
-	   been loaded, then the '+:' operator is defined and we use this
-	   representation. Otherwise, we print complex values as pairs of real
-	   and imaginary part. */
-	symbol *rect = interpreter::g_interp->symtab.complex_rect_sym();
-	if (rect)
-	  for (size_t i = 0; i < m->size1; i++) {
-	    if (i > 0) os << ";";
-	    for (size_t j = 0; j < m->size2; j++) {
-	      if (j > 0) os << ",";
-	      print_double(os, m->data[2*(i * m->tda + j)]);
-	      os << rect->s;
-	      print_double(os, m->data[2*(i * m->tda + j) + 1]);
-	    }
+	for (size_t i = 0; i < m->size1; i++) {
+	  if (i > 0) os << ";";
+	  for (size_t j = 0; j < m->size2; j++) {
+	    if (j > 0) os << ",";
+	    print_double(os, m->data[2*(i * m->tda + j)]);
+	    os << rectsym;
+	    print_double(os, m->data[2*(i * m->tda + j) + 1]);
 	  }
-	else
-	  for (size_t i = 0; i < m->size1; i++) {
-	    if (i > 0) os << ";";
-	    for (size_t j = 0; j < m->size2; j++) {
-	      if (j > 0) os << ",";
-	      os << "(";
-	      print_double(os, m->data[2*(i * m->tda + j)]);
-	      os << ",";
-	      print_double(os, m->data[2*(i * m->tda + j) + 1]);
-	      os << ")";
-	    }
-	  }
+	}
       }
     }
     return os << "}";

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-09-20 17:56:26 UTC (rev 810)
+++ pure/trunk/runtime.cc	2008-09-20 18:50:23 UTC (rev 811)
@@ -889,8 +889,7 @@
     symbol *rect = interp.symtab.complex_rect_sym(),
       *polar = interp.symtab.complex_polar_sym();
     if ((!rect || f->tag != rect->f) &&
-	(!polar || f->tag != polar->f) &&
-	f->tag != interp.symtab.pair_sym().f)
+	(!polar || f->tag != polar->f))
       return false;
     u = u->data.x[1];
     switch (u->tag) {
@@ -927,13 +926,13 @@
   if (rect)
     return pure_appl(pure_symbol(rect->f), 2, pure_double(a), pure_double(b));
   else
-    return pure_tuplel(2, pure_double(a), pure_double(b));
+    return 0;
 }
 
 static inline pure_expr *make_complex(double a, double b)
 {
   interpreter& interp = *interpreter::g_interp;
-  symbol *rect = interp.symtab.complex_rect_sym();
+  symbol *rect = interp.symtab.complex_rect_sym(true);
   return make_complex2(rect, a, b);
 }
 
@@ -1338,7 +1337,7 @@
       gsl_matrix_complex *mat1 = (gsl_matrix_complex*)x->data.mat.p;
       if (mat1) {
 	interpreter& interp = *interpreter::g_interp;
-	symbol *rect = interp.symtab.complex_rect_sym();
+	symbol *rect = interp.symtab.complex_rect_sym(true);
 	for (size_t j = 0; j < mat1->size1; i++, j++)
 	  for (size_t k = 0; k < mat1->size2; k++) {
 	    size_t l = 2*(j*mat1->tda+k);
@@ -1400,7 +1399,7 @@
       gsl_matrix_complex *mat1 = (gsl_matrix_complex*)x->data.mat.p;
       if (mat1) {
 	interpreter& interp = *interpreter::g_interp;
-	symbol *rect = interp.symtab.complex_rect_sym();
+	symbol *rect = interp.symtab.complex_rect_sym(true);
 	for (size_t j = 0; j < mat1->size1; j++)
 	  for (size_t k = 0; k < mat1->size2; k++) {
 	    size_t l = 2*(j*mat1->tda+k);

Modified: pure/trunk/symtable.cc
===================================================================
--- pure/trunk/symtable.cc	2008-09-20 17:56:26 UTC (rev 810)
+++ pure/trunk/symtable.cc	2008-09-20 18:50:23 UTC (rev 811)
@@ -374,3 +374,21 @@
   else
     return sym("&", 9, postfix);
 }
+
+symbol* symtable::complex_rect_sym(bool force)
+{
+  symbol *_sym = lookup("+:");
+  if (!force || _sym)
+    return _sym;
+  else
+    return &sym("+:", 5, infix);
+}
+
+symbol* symtable::complex_polar_sym(bool force)
+{
+  symbol *_sym = lookup("<:");
+  if (!force || _sym)
+    return _sym;
+  else
+    return &sym("<:", 5, infix);
+}

Modified: pure/trunk/symtable.hh
===================================================================
--- pure/trunk/symtable.hh	2008-09-20 17:56:26 UTC (rev 810)
+++ pure/trunk/symtable.hh	2008-09-20 18:50:23 UTC (rev 811)
@@ -100,9 +100,11 @@
   symbol& segfault_sym() { return sym("stack_fault"); }
   symbol& bad_matrix_sym() { return sym("bad_matrix_value"); }
   symbol& amp_sym();
-  // these may be undefined
-  symbol* complex_rect_sym() { return lookup("+:"); }
-  symbol* complex_polar_sym() { return lookup("<:"); }
+  // These aren't predefined and aren't in the prelude either, so they may be
+  // undefined in which case a null pointer is returned. Pass force=true to
+  // forcibly create these symbols.
+  symbol* complex_rect_sym(bool force = false);
+  symbol* complex_polar_sym(bool force = false);
 };
 
 #endif // ! SYMTABLE_HH


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