[project @ 2000-03-23 14:54:20 by sewardj]

[ghc-hetmet.git] / ghc / interpreter / output.c

diff --git a/ghc/interpreter/output.c b/ghc/interpreter/output.c
index 904d4c4..ad8b0ff 100644 (file)
--- a/ghc/interpreter/output.c
+++ b/ghc/interpreter/output.c
@@ -10,11 +10,11 @@
  * included in the distribution.
  *
  * $RCSfile: output.c,v $
- * $Revision: 1.8 $
- * $Date: 1999/10/20 02:16:02 $
+ * $Revision: 1.17 $
+ * $Date: 2000/03/23 14:54:21 $
  * ------------------------------------------------------------------------*/
 
-#include "prelude.h"
+#include "hugsbasictypes.h"
 #include "storage.h"
 #include "connect.h"
 #include "errors.h"
@@ -26,30 +26,31 @@
  * Local function prototypes:
  * ------------------------------------------------------------------------*/
 
-static Void local put            Args((Int,Cell));
-static Void local putFlds        Args((Cell,List));
-static Void local putComp        Args((Cell,List));
-static Void local putQual        Args((Cell));
-static Bool local isDictVal      Args((Cell));
-static Cell local maySkipDict    Args((Cell));
-static Void local putAp          Args((Int,Cell));
-static Void local putOverInfix   Args((Int,Text,Syntax,Cell));
-static Void local putInfix       Args((Int,Text,Syntax,Cell,Cell));
-static Void local putSimpleAp    Args((Cell,Int));
-static Void local putTuple       Args((Int,Cell));
-static Int  local unusedTups     Args((Int,Cell));
-static Void local unlexOp        Args((Text));
-
-static Void local putSigType     Args((Cell));
-static Void local putContext     Args((List,List,Int));
-static Void local putPred        Args((Cell,Int));
-static Void local putType        Args((Cell,Int,Int));
-static Void local putTyVar       Args((Int));
-static Bool local putTupleType   Args((Cell,Int));
-static Void local putApType      Args((Type,Int,Int));
-
-static Void local putKind        Args((Kind));
-static Void local putKinds       Args((Kinds));
+static Void local put            ( Int,Cell );
+static Void local putFlds        ( Cell,List );
+static Void local putComp        ( Cell,List );
+static Void local putQual        ( Cell );
+static Bool local isDictVal      ( Cell );
+static Cell local maySkipDict    ( Cell );
+static Void local putAp          ( Int,Cell );
+static Void local putOverInfix   ( Int,Text,Syntax,Cell );
+static Void local putInfix       ( Int,Text,Syntax,Cell,Cell );
+static Void local putSimpleAp    ( Cell,Int );
+static Void local putTuple       ( Int,Cell );
+static Int  local unusedTups     ( Int,Cell );
+static Void local unlexOp        ( Text );
+
+static Void local putSigType     ( Cell );
+static Void local putContext     ( List,List,Int );
+static Void local putPred        ( Cell,Int );
+static Void local putType        ( Cell,Int,Int );
+static Void local putTyVar       ( Int );
+static Bool local putTupleType   ( Cell,Int );
+static Void local putApType      ( Type,Int,Int );
+
+static Void local putKind        ( Kind );
+static Void local putKinds       ( Kinds );
+
 
 /* --------------------------------------------------------------------------
  * Basic output routines:
@@ -205,7 +206,7 @@ Cell e; {
 
         case FLOATCELL  : {   Float f = floatOf(e);
                               if (f<0 && d>=UMINUS_PREC) putChr('(');
-                              putStr(floatToString(f));
+                              putStr(floatToString(e));
                               if (f<0 && d>=UMINUS_PREC) putChr(')');
                           }
                           break;
@@ -214,7 +215,7 @@ Cell e; {
                           break;
 
         case LETREC     : OPEN(d>WHERE_PREC);
-#if DEBUG_CODE
+#if 0
                           putStr("let {");
                           put(NEVER,fst(snd(e)));
                           putStr("} in ");
@@ -270,7 +271,7 @@ Cell e; {
 
         case CASE       : putStr("case ");
                           put(NEVER,fst(snd(e)));
-#if DEBUG_CODE
+#if 0
                           putStr(" of {");
                           put(NEVER,snd(snd(e)));
                           putChr('}');
@@ -356,7 +357,7 @@ Cell q; {
 
 static Bool local isDictVal(e)          /* Look for dictionary value       */
 Cell e; {
-#if !DEBUG_CODE
+#if 0   /* was !DEBUG_CODE -- is it necessary? */
     Cell h = getHead(e);
     switch (whatIs(h)) {
         case DICTVAR : return TRUE;
@@ -377,7 +378,7 @@ static Void local putAp(d,e)            /* print application (args>=1)     */
 Int  d;
 Cell e; {
     Cell   h;
-    Text   t;
+    Text   t = 0;                       /* bogus init to keep gcc -O happy */
     Syntax sy;
     Int    args = 0;
 
@@ -391,14 +392,12 @@ Cell e; {
     }
 
     switch (whatIs(h)) {
-#if NPLUSK
         case ADDPAT     : if (args==1)
                               putInfix(d,textPlus,syntaxOf(namePlus),
                                          arg(e),mkInt(intValOf(fun(e))));
                           else
                               putStr("ADDPAT");
                           return;
-#endif
 
         case TUPLE      : OPEN(args>tupleOf(h) && d>=FUN_PREC);
                           putTuple(tupleOf(h),e);
@@ -550,12 +549,13 @@ Cell e; {                               /* args not yet printed ...        */
     return ts;
 }
 
-Void unlexVar(t)                       /* print text as a variable name    */
-Text t; {                              /* operator symbols must be enclosed*/
-    String s = textToStr(t);           /* in parentheses... except [] ...  */
-
+Void unlexVarStr(s)
+String s; {
     if ((isascii((int)(s[0])) && isalpha((int)(s[0]))) 
-       || s[0]=='_' || s[0]=='[' || s[0]=='(')
+        || s[0]=='_' || s[0]=='[' || s[0]=='('
+        || s[0]=='$'
+        || (s[0]==':' && s[1]=='D')
+       )
         putStr(s);
     else {
         putChr('(');
@@ -564,6 +564,11 @@ Text t; {                              /* operator symbols must be enclosed*/
     }
 }
 
+Void unlexVar(t)                       /* print text as a variable name    */
+Text t; {                              /* operator symbols must be enclosed*/
+    unlexVarStr(textToStr(t));         /* in parentheses... except [] ...  */
+}
+
 static Void local unlexOp(t)           /* print text as operator name      */
 Text t; {                              /* alpha numeric symbols must be    */
     String s = textToStr(t);           /* enclosed by backquotes           */
@@ -640,6 +645,7 @@ Int  fr; {
     Bool useParens = len!=1;
 #endif
     if (useParens)
+        putChr('(');
     for (; nonNull(ps); ps=tl(ps)) {
         putPred(hd(ps),fr);
         if (--c > 0) {
@@ -919,6 +925,11 @@ Kinds ks; {
  * Main drivers:
  * ------------------------------------------------------------------------*/
 
+FILE *mystdout ( Void ) {
+  /* We use this from the gdb command line when debugging */
+  return stdout;
+}
+
 Void printExp(fp,e)                     /* print expr on specified stream  */
 FILE *fp;
 Cell e; {