* Unparse expressions and types - for use in error messages, type checker
* and for debugging.
*
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: output.c,v $
- * $Revision: 1.4 $
- * $Date: 1999/03/01 14:46:50 $
+ * $Revision: 1.13 $
+ * $Date: 1999/11/29 18:59:29 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
static Void local putKind Args((Kind));
static Void local putKinds Args((Kinds));
+
/* --------------------------------------------------------------------------
* Basic output routines:
* ------------------------------------------------------------------------*/
case CONOPCELL : unlexVar(textOf(e));
break;
+#if IPARAM
+ case IPVAR : putChr('?');
+ unlexVar(textOf(e));
+ break;
+
+ case WITHEXP : OPEN(d>WHERE_PREC);
+ putStr("dlet {...} in ");
+ put(WHERE_PREC+1,fst(snd(e)));
+ CLOSE(d>WHERE_PREC);
+ break;
+#endif
+
#if TREX
case RECSEL : putChr('#');
unlexVar(extText(snd(e)));
}
break;
-#if BIGNUMS
- case NEGNUM :
- case ZERONUM :
- case POSNUM : xs = bigOut(e,NIL,d>=UMINUS_PREC);
- for (; nonNull(xs); xs=tl(xs))
- putChr(charOf(arg(hd(xs))));
- break;
-#endif
-
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;
Int d;
Cell e; {
Cell h;
- Text t;
+ Text t = 0; /* bogus init to keep gcc -O happy */
Syntax sy;
Int args = 0;
case NAME : if (args==1 &&
((h==nameFromInt && isInt(arg(e))) ||
-#if BIGNUMS
- (h==nameFromInteger && isBignum(arg(e))) ||
-#endif
(h==nameFromDouble && isFloat(arg(e))))) {
put(d,arg(e));
return;
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('(');
}
}
+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 */
Int fr; {
Int len = length(ps) + length(qs);
Int c = len;
- if (len!=1) {
+#if IPARAM
+ Bool useParens = len!=1 || isIP(fun(hd(ps)));
+#else
+ Bool useParens = len!=1;
+#endif
+ if (useParens)
putChr('(');
- }
for (; nonNull(ps); ps=tl(ps)) {
putPred(hd(ps),fr);
if (--c > 0) {
putStr(", ");
}
}
- if (len!=1) {
+ if (useParens)
putChr(')');
- }
}
static Void local putPred(pi,fr) /* Output predicate */
return;
}
#endif
+#if IPARAM
+ if (whatIs(fun(pi)) == IPCELL) {
+ putChr('?');
+ putPred(fun(pi),fr);
+ putStr(" :: ");
+ putType(arg(pi),NEVER,fr);
+ return;
+ }
+#endif
putPred(fun(pi),fr);
putChr(' ');
putType(arg(pi),ALWAYS,fr);
putStr(textToStr(cclass(pi).text));
else if (isCon(pi))
putStr(textToStr(textOf(pi)));
+#if IPARAM
+ else if (whatIs(pi) == IPCELL)
+ unlexVar(textOf(pi));
+#endif
else
putStr("<unknownPredicate>");
}
for (; isAp(ks); ks=tl(ks)) {
putTyVar(fr++);
if (isAp(tl(ks)))
- putChr(',');
+ putChr(' ');
}
putStr(". ");
putType(monotypeOf(t),NEVER,fr);
CLOSE(prec>=ARROW_PREC);
return;
}
+#if 0
else if (argCount==1) {
putChr('(');
putType(arg(t),ARROW_PREC,fr);
putStr("->)");
return;
}
+#endif
}
else if (isTuple(typeHead)) {
if (argCount==tupleOf(typeHead)) {
putStr(punc);
punc = ", ";
putStr(textToStr(extText(typeHead)));
- putStr("::");
+ putStr(" :: ");
putType(extField(t),NEVER,fr);
t = extRow(t);
typeHead = getHead(t);
* Main drivers:
* ------------------------------------------------------------------------*/
+extern FILE *mystdout Args((Void));
+FILE *mystdout() {
+ /* 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; {
putKinds(ks);
}
+Void printFD(fp,fd) /* print functional dependency */
+FILE* fp;
+Pair fd; {
+ List us;
+ outputStream = fp;
+ for (us=fst(fd); nonNull(us); us=tl(us)) {
+ putTyVar(offsetOf(hd(us)));
+ if (nonNull(tl(us))) {
+ putChr(' ');
+ }
+ }
+ putStr(" -> ");
+ for (us=snd(fd); nonNull(us); us=tl(us)) {
+ putTyVar(offsetOf(hd(us)));
+ if (nonNull(tl(us))) {
+ putChr(' ');
+ }
+ }
+}
+
/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff