[project @ 2000-04-25 17:43:49 by andy]

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

diff --git a/ghc/interpreter/output.c b/ghc/interpreter/output.c
index 03187a5..c4ed363 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.12 $
- * $Date: 1999/11/12 17:32:42 $
+ * $Revision: 1.18 $
+ * $Date: 2000/04/25 17:43:50 $
  * ------------------------------------------------------------------------*/
 
-#include "prelude.h"
+#include "hugsbasictypes.h"
 #include "storage.h"
 #include "connect.h"
 #include "errors.h"
@@ -26,30 +26,30 @@
  * 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 );
 
 
 /* --------------------------------------------------------------------------
@@ -188,6 +188,9 @@ Cell e; {
         case DOCOMP     : putStr("do {...}");
                           break;
 
+        case MDOCOMP    : putStr("do {...}");
+                          break;
+
         case COMP       : putComp(fst(snd(e)),snd(snd(e)));
                           break;
 
@@ -215,7 +218,7 @@ Cell e; {
                           break;
 
         case LETREC     : OPEN(d>WHERE_PREC);
-#if DEBUG_CODE
+#if 0
                           putStr("let {");
                           put(NEVER,fst(snd(e)));
                           putStr("} in ");
@@ -271,7 +274,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('}');
@@ -357,7 +360,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;
@@ -392,14 +395,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);
@@ -551,12 +552,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('(');
@@ -565,6 +567,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           */
@@ -921,8 +928,7 @@ Kinds ks; {
  * Main drivers:
  * ------------------------------------------------------------------------*/
 
-extern FILE *mystdout Args((Void));
-FILE *mystdout() {
+FILE *mystdout ( Void ) {
   /* We use this from the gdb command line when debugging */
   return stdout;
 }