aboutsummaryrefslogtreecommitdiff
path: root/backendC/CleanCompilerSources/dbprint.c
diff options
context:
space:
mode:
Diffstat (limited to 'backendC/CleanCompilerSources/dbprint.c')
-rw-r--r--backendC/CleanCompilerSources/dbprint.c832
1 files changed, 832 insertions, 0 deletions
diff --git a/backendC/CleanCompilerSources/dbprint.c b/backendC/CleanCompilerSources/dbprint.c
new file mode 100644
index 0000000..2e3fc36
--- /dev/null
+++ b/backendC/CleanCompilerSources/dbprint.c
@@ -0,0 +1,832 @@
+
+#include "system.h"
+#include "syntaxtr.t"
+#include "comsupport.h"
+#include "settings.h"
+#include "sizes.h"
+#include "checker.h"
+#include "checksupport.h"
+#include "overloading.h"
+#include "dbprint.h"
+#include "codegen_types.h"
+
+#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
+
+#define PrintAnnotation(annot)
+
+#undef PRINT_alt_lifted_node_ids
+#undef PRINT_NODE_ID_REF_COUNTS
+#define PRINT_ALL_NODE_ID_ADDRESSES
+#undef PRINT_NODE_LINE_NUMBERS
+#define PRINT_NODE_ID_REF_COUNT
+
+static void PrintUnaryState (StateKind kind, ObjectKind obj, File file)
+{
+ switch (kind)
+ { case OnB: FPutS ("OnB ", file); break;
+ case OnA: FPutS ("OnA ", file); break;
+ case StrictOnA: FPutS ("StrictOnA ", file); break;
+ case SemiStrict: FPutS ("SemiStrict ", file); break;
+ case StrictRedirection: FPutS ("StrictRedirection ", file); break;
+ case Parallel: FPutS ("Parallel ", file); break;
+ case Undefined: FPutS ("Undefined ", file); break;
+ case UnderEval: FPutS ("UnderEval ", file); break;
+ }
+ switch (obj)
+ { case UnknownObj: FPutS ("???", file); break;
+ case IntObj: FPutS ("Int ", file); break;
+ case BoolObj: FPutS ("Bool ", file); break;
+ case CharObj: FPutS ("Char ", file); break;
+ case StringObj: FPutS ("String ", file); break;
+ case RealObj: FPutS ("Real ", file); break;
+ case FileObj: FPutS ("File ", file); break;
+ case TupleObj: FPutS ("Tuple ", file); break;
+ case ListObj: FPutS ("List ", file); break;
+ case ProcIdObj: FPutS ("ProcId ", file); break;
+ }
+}
+
+static void PrintState (StateS state, File file)
+{
+ return;
+
+ if (state.state_arity == 1)
+ PrintUnaryState (state.state_kind,state.state_object, file);
+}
+
+void DPrintOccurrenceKind (OccurrenceKind kind, File file)
+{
+ switch (kind)
+ { case NotUsed: /* FPutS ("NotUsed", file); */ return;
+ case UniquelyUsed: FPutS ("<U> ", file); return;
+ case SelectivelyUsed: FPutS ("<S> ", file); return;
+ case MultiplyUsed: FPutS ("<M> ", file); return;
+ default: FPutS ("<?> ", file); return;
+ }
+
+}
+
+void DPrintNodeId (NodeId nid, File file)
+{
+ if (nid){
+ if (nid->nid_ident){
+ FPrintF (file, "%s",nid->nid_ident->ident_name);
+#ifdef PRINT_ALL_NODE_ID_ADDRESSES
+ FPrintF (file, "@i_%lx", (long) nid);
+#endif
+ } else
+ FPrintF (file, "i_%lx", (long) nid);
+
+#ifdef PRINT_NODE_ID_REF_COUNT
+ FPrintF (file, "<%d>", nid->nid_refcount);
+#endif
+ } else
+ FPrintF (file," 00000000");
+}
+
+void DPrintNodeIdS (char *s,NodeId node_id,File file)
+{
+ FPrintF (file,"%s",s);
+ DPrintNodeId (node_id,file);
+ FPrintF (file,"\n");
+}
+
+static void DPrintTypeVar (TypeVar tv, Node follow, File file)
+{
+ if (tv){
+ if (tv->tv_ident)
+ FPrintF (file, "%s",tv->tv_ident->ident_name);
+ else
+ FPrintF (file, "i_%lx", (long) tv);
+ FPrintF (file, "<%d>", tv->tv_refcount);
+ if (follow)
+ FPutS (" = ", file);
+ }
+}
+
+static void PrintArgument (Args arg,Bool brackets,int n_leading_spaces,File file)
+{
+ PrintState (arg->arg_state, file);
+
+ if (arg->arg_node->node_kind==NodeIdNode)
+ DPrintNodeId (arg->arg_node->node_node_id,file);
+ else {
+ /* DPrintOccurrenceKind (arg -> arg_occurrence); */
+ PrintRuleNode (arg->arg_node,brackets,n_leading_spaces,file);
+ }
+}
+
+static void print_spaces (int n_leading_spaces,File file)
+{
+ int n;
+
+ for (n=0; n<n_leading_spaces; ++n)
+ FPutC (' ',file);
+}
+
+static void PrintArguments (Args args, char separator, Bool brackets,int n_leading_spaces,File file)
+{
+ if (args!=NULL){
+ PrintArgument (args,brackets,n_leading_spaces,file);
+ for (args = args -> arg_next; args; args = args -> arg_next){
+ FPutC (separator, file);
+ if (separator=='\n')
+ print_spaces (n_leading_spaces,file);
+ PrintArgument (args, brackets,n_leading_spaces,file);
+ }
+ }
+}
+
+void PrintRuleNode (Node node,Bool brackets,int n_leading_spaces,File file)
+{
+/*
+ if (IsOnACycle (node -> node_number))
+ FPutS ("<C>", file);
+ PrintState (node -> node_state,file);
+*/
+ switch (node -> node_kind){
+ case NormalNode:
+ case PrefixNode:
+ {
+ Symbol node_symb = node->node_symbol;
+
+ if (node_symb -> symb_kind == tuple_symb){
+ FPutC ('(', file);
+ PrintArguments (node -> node_arguments, ',', False,n_leading_spaces,file);
+ FPutC (')', file);
+ }
+ else if (node_symb -> symb_kind == list_type)
+ { FPutC ('[', file);
+ PrintArguments (node -> node_arguments, ',', False,n_leading_spaces,file);
+ FPutC (']', file);
+ }
+ else if (node_symb -> symb_kind == nil_symb)
+ FPutS ("[]", file);
+ else if (node_symb -> symb_kind == cons_symb)
+ { FPutC ('[', file);
+ PrintArgument (node -> node_arguments, brackets,n_leading_spaces,file);
+ FPutC (':', file);
+ PrintArgument (node -> node_arguments -> arg_next, brackets,n_leading_spaces,file);
+ FPutC (']', file);
+ } else if (node_symb -> symb_kind==select_symb){
+ FPutS ("_sel",file);
+ FPutC ('0'+node->node_arity,file);
+ FPutC (' ',file);
+ PrintArgument (node -> node_arguments,True,n_leading_spaces,file);
+ } else {
+ if (brackets && node -> node_arguments)
+ FPutC ('(', file);
+
+ PrintSymbol (node_symb, file);
+
+#ifdef PRINT_NODE_LINE_NUMBERS
+ FPrintF (file,"#%d",node->node_line);
+#endif
+ if (node_symb->symb_kind==definition && node_symb->symb_def->sdef_kind==IMPRULE &&
+ (node_symb->symb_def->sdef_rule->rule_mark & RULE_INTERNAL_FUNCTION_MASK))
+ {
+ FPrintF (file,"_%d",node_symb->symb_def->sdef_number);
+ }
+
+ if (node -> node_arguments)
+ { FPutC (' ', file);
+ PrintArguments (node -> node_arguments,' ', True,n_leading_spaces,file);
+ if (brackets)
+ FPutC (')', file);
+ }
+ }
+ break;
+ }
+ case SelectorNode:
+ PrintArgument (node -> node_arguments, True,n_leading_spaces,file);
+ if (node->node_arity>1){
+ FPutC ('!',file);
+ FPutC ('0'+node->node_arity,file);
+ } else
+ FPutC ('.',file);
+ PrintSymbol (node->node_symbol, file);
+ break;
+ case IfNode:
+ {
+ Args elsepart, thenpart, condpart;
+
+ condpart = node -> node_arguments;
+ thenpart = condpart -> arg_next;
+ elsepart = thenpart -> arg_next;
+
+ if (brackets)
+ FPutC ('(', file);
+
+ FPutS ("IF ", file);
+ PrintArgument (condpart, True,n_leading_spaces,file);
+
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+#if 1
+# ifdef PRINT_NODE_ID_REF_COUNTS
+ FPutS ("[ ", file);
+ {
+ NodeIdRefCountListP node_id_ref_count_elem;
+
+ for_l (node_id_ref_count_elem,node->node_then_node_id_ref_counts,nrcl_next){
+ DPrintNodeId (node_id_ref_count_elem->nrcl_node_id,file);
+ printf (" %d ",node_id_ref_count_elem->nrcl_ref_count);
+ }
+ }
+ FPutS ("]\n", file);
+ print_spaces (n_leading_spaces+4,file);
+# else
+ if (node->node_then_strict_node_ids!=NULL){
+ StrictNodeIdP strict_node_id;
+
+ FPutS ("let! ", file);
+
+ for_l (strict_node_id,node->node_then_strict_node_ids,snid_next){
+ DPrintNodeId (strict_node_id->snid_node_id,file);
+ FPutS ("; ",file);
+ }
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+ }
+# endif
+#endif
+ PrintArgument (thenpart, True,n_leading_spaces+4,file);
+
+ if (node->node_then_node_defs!=NULL){
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+ FPutS ("{\n",file);
+ PrintNodeDefs (node->node_then_node_defs,n_leading_spaces+8,file);
+ print_spaces (n_leading_spaces+4,file);
+ FPutC ('}', file);
+ }
+
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+
+#if 1
+# ifdef PRINT_NODE_ID_REF_COUNTS
+ FPutS ("[ ", file);
+ {
+ NodeIdRefCountListP node_id_ref_count_elem;
+
+ for_l (node_id_ref_count_elem,node->node_else_node_id_ref_counts,nrcl_next){
+ DPrintNodeId (node_id_ref_count_elem->nrcl_node_id,file);
+ printf (" %d ",node_id_ref_count_elem->nrcl_ref_count);
+ }
+ }
+ FPutS ("]\n",file);
+ print_spaces (n_leading_spaces+4,file);
+# else
+ if (node->node_else_strict_node_ids!=NULL){
+ StrictNodeIdP strict_node_id;
+
+ FPutS ("let! ", file);
+
+ for (strict_node_id=node->node_else_strict_node_ids; strict_node_id!=NULL; strict_node_id=strict_node_id->snid_next){
+ DPrintNodeId (strict_node_id->snid_node_id,file);
+ FPutS ("; ",file);
+ }
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+ }
+# endif
+#endif
+
+ PrintArgument (elsepart, True,n_leading_spaces+4,file);
+
+ if (node->node_else_node_defs!=NULL){
+ FPutC ('\n', file);
+ print_spaces (n_leading_spaces+4,file);
+ FPutS ("{\n",file);
+ PrintNodeDefs (node->node_else_node_defs,n_leading_spaces+8,file);
+ print_spaces (n_leading_spaces+4,file);
+ FPutS ("}\n", file);
+ print_spaces (n_leading_spaces,file);
+ }
+
+ if (brackets)
+ FPutC (')', file);
+ break;
+ }
+ case NodeIdNode:
+ {
+ NodeId node_id;
+
+ node_id=node->node_node_id;
+
+ if (node_id->nid_ident){
+ FPrintF (file, " %s<%d>",node_id->nid_ident->ident_name,node_id->nid_refcount);
+#ifdef PRINT_ALL_NODE_ID_ADDRESSES
+ FPrintF (file, " i_%lx",(long) node_id);
+#endif
+ } else
+ FPrintF (file, " i_%lx<%d>",(long) node_id,node_id->nid_refcount);
+ break;
+ }
+ case RecordNode:
+ if (brackets && node -> node_arguments)
+ FPutC ('(', file);
+ PrintSymbol (node->node_symbol, file);
+ if (node -> node_arguments){
+ FPutC (' ', file);
+ PrintArguments (node -> node_arguments,' ', True,n_leading_spaces,file);
+ if (brackets)
+ FPutC (')', file);
+ }
+ break;
+ case IdentNode:
+ if (brackets && node -> node_arguments)
+ FPutC ('(', file);
+
+ FPutC ('\"',file);
+ FPutS (node->node_ident->ident_name, file);
+ FPutC ('\"',file);
+
+ if (node -> node_arguments){
+ FPutC (' ', file);
+ PrintArguments (node -> node_arguments,' ', True,n_leading_spaces,file);
+ if (brackets)
+ FPutC (')', file);
+ }
+ break;
+ case UpdateNode:
+ { Args field = node -> node_arguments;
+
+ FPutC ('{', file);
+
+ PrintArgument (field, False,n_leading_spaces,file);
+ FPutS (" & ", file);
+ field = field -> arg_next;
+ PrintArgument (field, False,n_leading_spaces,file);
+ for (field = field -> arg_next; field; field = field -> arg_next)
+ { FPutC (',', file);
+ PrintArgument (field, False,n_leading_spaces,file);
+ }
+
+ FPutC ('}', file);
+ break;
+ }
+ case MatchNode:
+ {
+ FPutS ("Match ",file);
+ PrintSymbol (node->node_symbol,file);
+ FPutC (' ',file);
+ PrintArgument (node->node_arguments,False,n_leading_spaces,file);
+ break;
+ }
+ case ApplyNode:
+ {
+ FPutS ("Apply ",file);
+ PrintRuleNode (node->node_node, False,n_leading_spaces,file);
+ FPutC (' ',file);
+ PrintArgument (node->node_arguments,False,n_leading_spaces,file);
+ break;
+ }
+ case SwitchNode:
+ FPutS ("Switch ",file);
+ DPrintNodeId (node->node_node_id,file);
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces,file);
+ PrintArguments (node->node_arguments,'\n',True,n_leading_spaces,file);
+ break;
+ case CaseNode:
+ FPutS ("Case: [ ",file);
+ {
+ NodeIdRefCountListP node_id_ref_count_elem;
+
+ for_l (node_id_ref_count_elem,node->node_node_id_ref_counts,nrcl_next){
+ DPrintNodeId (node_id_ref_count_elem->nrcl_node_id,file);
+ printf (" %d ",node_id_ref_count_elem->nrcl_ref_count);
+ }
+ }
+ FPutS ("]\n",file);
+ print_spaces (n_leading_spaces+4,file);
+
+#if 0
+# ifndef PRINT_NODE_ID_REF_COUNTS
+ if (node->node_strict_node_ids!=NULL){
+ StrictNodeIdP strict_node_id;
+
+ FPutS ("let! ", file);
+
+ for_l (strict_node_id,node->node_strict_node_ids,snid_next){
+ if (strict_node_id->snid_mark & STRICT_NODE_ID_IDENT_MASK){
+ FPrintF (file, " %s",strict_node_id->snid_ident->ident_name);
+ } else {
+ DPrintNodeId (strict_node_id->snid_node_id,file);
+ FPutS ("; ",file);
+ }
+ }
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+ }
+# endif
+#endif
+ PrintArgument (node->node_arguments,False,n_leading_spaces+4,file);
+
+ if (node->node_node_defs!=NULL){
+ FPutC ('\n', file);
+ print_spaces (n_leading_spaces,file);
+ FPutS ("{\n",file);
+ PrintNodeDefs (node->node_node_defs,n_leading_spaces+4,file);
+ print_spaces (n_leading_spaces,file);
+ FPutS ("}\n", file);
+ print_spaces (n_leading_spaces,file);
+ }
+
+ break;
+ case DefaultNode:
+ FPutS ("Default: [ ",file);
+ {
+ NodeIdRefCountListP node_id_ref_count_elem;
+
+ for_l (node_id_ref_count_elem,node->node_node_id_ref_counts,nrcl_next){
+ DPrintNodeId (node_id_ref_count_elem->nrcl_node_id,file);
+ printf (" %d ",node_id_ref_count_elem->nrcl_ref_count);
+ }
+ }
+ FPutS ("]\n",file);
+ print_spaces (n_leading_spaces+4,file);
+
+#if 0
+# ifndef PRINT_NODE_ID_REF_COUNTS
+ if (node->node_strict_node_ids!=NULL){
+ StrictNodeIdP strict_node_id;
+
+ FPutS ("let! ", file);
+
+ for_l (strict_node_id,node->node_strict_node_ids,snid_next){
+ if (strict_node_id->snid_mark & STRICT_NODE_ID_IDENT_MASK){
+ FPrintF (file, " %s",strict_node_id->snid_ident->ident_name);
+ } else {
+ DPrintNodeId (strict_node_id->snid_node_id,file);
+ FPutS ("; ",file);
+ }
+ }
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces+4,file);
+ }
+# endif
+#endif
+ PrintArgument (node->node_arguments,False,n_leading_spaces+4,file);
+
+ if (node->node_node_defs!=NULL){
+ FPutC ('\n', file);
+ print_spaces (n_leading_spaces,file);
+ FPutS ("{\n",file);
+ PrintNodeDefs (node->node_node_defs,n_leading_spaces+4,file);
+ print_spaces (n_leading_spaces,file);
+ FPutS ("}\n", file);
+ print_spaces (n_leading_spaces,file);
+ }
+ break;
+ case PushNode:
+ {
+ NodeIdListElementP node_id_list;
+
+ FPutS ("Push ",file);
+ DPrintNodeId (node->node_arguments->arg_node->node_node_id,file);
+ FPutS ("[",file);
+ for_l (node_id_list,node->node_node_ids,nidl_next){
+ DPrintNodeId (node_id_list->nidl_node_id,file);
+ if (node_id_list->nidl_next!=NULL)
+ FPutC (' ',file);
+ }
+ FPutS ("]",file);
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces,file);
+ PrintArgument (node->node_arguments->arg_next,True,n_leading_spaces,file);
+ break;
+ }
+ case GuardNode:
+ FPutS ("Guard ",file);
+ PrintArguments (node->node_arguments,'\n',True,n_leading_spaces,file);
+ break;
+ case TupleSelectorsNode:
+ FPutS ("TupleSelectors (",file);
+ PrintArguments (node->node_arguments,',',True,n_leading_spaces,file);
+ FPutS (") = ",file);
+ PrintRuleNode (node->node_node,True,n_leading_spaces,file);
+ break;
+ case ScopeNode:
+ FPutS ("ScopeNode ",file);
+ PrintRuleNode (node->node_node,True,n_leading_spaces,file);
+ if (node->node_arguments!=NULL){
+ FPutS (" ScopeNodeArguments ",file);
+ PrintArguments (node->node_arguments,' ',True,n_leading_spaces,file);
+ }
+ break;
+ case FillUniqueNode:
+ FPutS ("FillUniqueNode ",file);
+ DPrintNodeId (node->node_node->node_arguments->arg_node->node_node_id,file);
+ FPutC (' ',file);
+ PrintArguments (node->node_arguments,' ',True,n_leading_spaces,file);
+ break;
+ default:
+ FPutC ('?',file);
+ FPrintF (file,"%d",(int)node->node_kind);
+ }
+}
+
+void PrintNodeDef (NodeDefP def_p,int n_leading_spaces,File file)
+{
+ int n;
+
+ /* FPrintF (file, "%d: ", (int) def_p->def_number); */
+
+ for (n=n_leading_spaces; n>0; --n)
+ FPutC (' ',file);
+
+/* if (def_p->def_has_lhs_pattern)
+ PrintRuleNode (def_p->def_pattern,False,n_leading_spaces,file);
+ else
+*/
+ DPrintNodeId (def_p -> def_id, file);
+
+ if (def_p -> def_node){
+ FPutS (" = ", file);
+ PrintRuleNode (def_p->def_node, False,n_leading_spaces,file);
+ }
+
+ FPutS ("\n",file);
+}
+
+void PrintNodeDefs (NodeDefs defs,int n_leading_spaces,File file)
+{
+ for ( ; defs!=NULL; defs=defs->def_next)
+ PrintNodeDef (defs,n_leading_spaces,file);
+}
+
+STRUCT (lifted_node_id,LiftedNodeId){
+ NodeId lnid_lifted_node_id;
+ NodeId lnid_lhs_node_id;
+ struct lifted_node_id * lnid_next;
+};
+
+void PrintRuleAlt (RuleAlts rulealt,int n_leading_spaces,File file)
+{
+ PrintRuleNode (rulealt->alt_lhs_root, False,n_leading_spaces,file);
+
+#ifdef PRINT_alt_lifted_node_ids
+ if (rulealt->alt_lifted_node_ids){
+ LiftedNodeId lifted_node_id_p;
+
+ FPutS (" <<",file);
+ for_l (lifted_node_id_p,rulealt->alt_lifted_node_ids,lnid_next){
+ FPutC (' ',file);
+ DPrintNodeId (lifted_node_id_p->lnid_lhs_node_id,file);
+ FPutC (':',file);
+ DPrintNodeId (lifted_node_id_p->lnid_lifted_node_id,file);
+ }
+ FPutS (" >>",file);
+ }
+#endif
+
+ if (rulealt->alt_lhs_defs){
+ FPutS ("\n", file);
+ PrintNodeDefs (rulealt -> alt_lhs_defs,4,file);
+ FPutS (" = ", file);
+ } else
+ FPutS ("\n = ", file);
+
+ if (rulealt -> alt_kind==Contractum){
+#if 1
+# ifndef PRINT_NODE_ID_REF_COUNTS
+ if (rulealt->alt_strict_node_ids!=NULL){
+ StrictNodeIdP strict_node_id;
+
+ FPutS ("let! ", file);
+
+ for_l (strict_node_id,rulealt->alt_strict_node_ids,snid_next){
+ if (strict_node_id->snid_mark & STRICT_NODE_ID_IDENT_MASK){
+ FPrintF (file, " %s",strict_node_id->snid_ident->ident_name);
+ } else {
+ DPrintNodeId (strict_node_id->snid_node_id,file);
+ FPutS ("; ",file);
+ }
+ }
+ FPutC ('\n',file);
+ print_spaces (n_leading_spaces,file);
+ }
+# endif
+#endif
+
+
+ PrintRuleNode (rulealt->alt_rhs_root, False,n_leading_spaces,file);
+ FPutS ("\n", file);
+ PrintNodeDefs (rulealt->alt_rhs_defs,4,file);
+ } else {
+/*
+ FPutS (rulealt->alt_rhs_root->node_node_id->nid_ident->ident_name,file);
+*/
+ }
+}
+
+static void PrintRuleAlts (RuleAlts rulealt,int n_leading_spaces,File file)
+{
+ for (; rulealt; rulealt = rulealt -> alt_next)
+ PrintRuleAlt (rulealt,n_leading_spaces,file);
+}
+
+static void PrintTypeArguments (TypeArgs args, char separator, File file)
+{
+ if (args){
+ PrintTypeNode (args->type_arg_node, file);
+
+ for (args = args->type_arg_next; args; args = args->type_arg_next){
+ FPutC (separator, file);
+ PrintTypeNode (args->type_arg_node, file);
+ }
+ }
+}
+
+static char *PrintUniVars = "uvwxyz";
+#define NrOfPrintUniVars 6
+
+void PrintTypeNode (TypeNode node, File file)
+{
+ if (node->type_node_annotation || node->type_node_annotation == StrictOnA)
+ FPutC ('!', file);
+
+ if (node->type_node_attribute == UniqueAttr)
+ FPutC ('*', file);
+ else if (node->type_node_attribute > UniqueAttr)
+ { unsigned node_attr = node->type_node_attribute - UniqueAttr;
+
+ if (node_attr < NrOfPrintUniVars)
+ { FPutC (PrintUniVars[node_attr], file);
+ FPutC (':', file);
+ }
+ else
+ FPrintF (file, "%u:", node_attr);
+ }
+
+ if (node->type_node_is_var)
+ FPutS (node->type_node_tv->tv_ident->ident_name, file);
+ else if (node->type_node_symbol->symb_kind == tuple_type)
+ { FPutC ('(', file);
+ PrintTypeArguments (node->type_node_arguments, ',', file);
+ FPutC (')', file);
+ }
+ else if (node->type_node_symbol->symb_kind == list_type)
+ { FPutC ('[', file);
+ PrintTypeArguments (node->type_node_arguments,',', file);
+ FPutC (']', file);
+ }
+ else if (node->type_node_symbol->symb_kind >= array_type &&
+ node->type_node_symbol->symb_kind <= unboxed_array_type)
+ { char *delim_chars = ":|#";
+ char array_delim = delim_chars [node->type_node_symbol->symb_kind - array_type];
+ FPutC ('{', file);
+ FPutC (array_delim, file);
+ PrintTypeArguments (node->type_node_arguments,',', file);
+ FPutC (array_delim, file);
+ FPutC ('}', file);
+ }
+ else if (node->type_node_symbol->symb_kind == apply_symb)
+ { FPutC ('(', file);
+ PrintTypeArguments (node -> type_node_arguments, ' ', file);
+ FPutC (')', file);
+ } else
+ { if (node->type_node_arguments)
+ FPutC ('(', file);
+
+ PrintSymbol (node->type_node_symbol, file);
+
+ if (node->type_node_arguments){
+ FPutC (' ', file);
+
+ PrintTypeArguments (node->type_node_arguments,' ', file);
+
+ FPutC (')', file);
+ }
+ }
+}
+
+static void PrintAttribute (AttributeKind attr, File file)
+{
+ if (attr == NotUniqueAttr)
+ return;
+ else if (attr == UniqueAttr)
+ FPutC ('*', file);
+ else
+ FPrintF (file, "%d", attr - UniqueAttr, file);
+
+}
+
+static void PrintTypeAttrEquations (UniVarEquations equs, File file)
+{
+ for (; equs; equs = equs -> uve_next)
+ { AttributeKindList next;
+ PrintAttribute (equs -> uve_demanded, file);
+ FPutC (':', file);
+ for (next = equs -> uve_offered; next; next = next -> akl_next)
+ { FPutC (' ', file);
+ PrintAttribute (next -> akl_elem, file);
+ }
+ }
+}
+
+static void PrintTypeContext (TypeContext type_context, File file)
+{
+ SymbolList symbols;
+
+ for (symbols = type_context -> tyco_symbols; symbols; symbols = symbols -> sl_next)
+ { PrintSymbol (symbols -> sl_symbol -> sdef_class -> cd_symbol, file);
+ FPutC (' ', file);
+ DPrintTypeVar (type_context -> tyco_variable, NULL, file);
+ }
+}
+
+static void PrintTypeContexts (TypeContext type_contexts, File file)
+{
+ PrintTypeContext (type_contexts, file);
+
+ for (type_contexts = type_contexts -> tyco_next; type_contexts; type_contexts = type_contexts -> tyco_next)
+ { FPutS (" & ", file);
+ PrintTypeContext (type_contexts, file);
+ }
+}
+
+void PrintTypeAlt (TypeAlts type_alts, File file, Bool with_equats)
+{
+ TypeNode lhs_root = type_alts -> type_alt_lhs;
+
+ PrintSymbol (lhs_root -> type_node_symbol, file);
+ FPutS (" :: ", file);
+ PrintTypeArguments (lhs_root -> type_node_arguments, ' ', file);
+
+ FPutS (" -> ", file);
+ PrintTypeNode (type_alts -> type_alt_rhs, file);
+ if (type_alts -> type_alt_type_context)
+ { FPutS (" | ", file);
+ PrintTypeContexts (type_alts -> type_alt_type_context, file);
+ }
+ FPutC ('\n', file);
+ if (with_equats)
+ { PrintTypeAttrEquations (type_alts -> type_alt_attr_equations, file);
+ FPutC ('\n', file);
+ }
+}
+
+void PrintImpRule (ImpRules rule,int n_leading_spaces,File file)
+{
+ /*
+ if (rule -> rule_type)
+ PrintTypeAlt (rule -> rule_type, file);
+ */
+
+ PrintRuleAlts (rule->rule_alts,n_leading_spaces,file);
+}
+
+void PrintRules (ImpRules rules)
+{
+ ImpRuleS *rule;
+
+ for_l (rule,rules,rule_next){
+ PrintImpRule (rule,4,StdOut);
+
+ if (rule->rule_next!=NULL)
+ FPutC ('\n',StdOut);
+ }
+}
+
+#ifdef _COMPSTATS_
+
+unsigned long
+ NrNodeCells,
+ NrArgCells,
+ NrTypeNodeCells,
+ NrTypeArgCells,
+ NrExpandedTypeNodeCells,
+ NrExpandedTypeArgCells,
+ NrNodeIdCells,
+ NrSymbolCells,
+ NrBasicNodes;
+
+void InitDB (void)
+{
+ NrArgCells = NrNodeCells = NrNodeIdCells =0;
+ NrTypeArgCells = NrTypeNodeCells =0;
+ NrExpandedTypeNodeCells = NrExpandedTypeArgCells = 0;
+ NrBasicNodes = NrSymbolCells = 0;
+}
+
+extern unsigned long NrOfBytes;
+void PrintCompStats (void, File file)
+{
+ FPutC('\n', file);
+ FPrintF (file, "Number of nodes: %lu\n", NrNodeCells);
+ FPrintF (file, "Number of arguments: %lu\n", NrArgCells);
+ FPrintF (file, "Number of type nodes: %lu\n", NrTypeNodeCells);
+ FPrintF (file, "Number of type arguments: %lu\n", NrTypeArgCells);
+ FPrintF (file, "Number of expanded type nodes: %lu\n", NrExpandedTypeNodeCells);
+ FPrintF (file, "Number of expanded type arguments: %lu\n", NrExpandedTypeArgCells);
+ FPrintF (file, "Number of nodeids: %lu\n", NrNodeIdCells);
+ FPrintF (file, "Number of symbols: %lu\n", NrSymbolCells);
+ FPrintF (file, "Number of basic nodes: %lu\n", NrBasicNodes);
+ FPrintF (file, "Total number of bytes: %lu\n", NrOfBytes);
+}
+
+#endif