Commit 4823fc73 authored by John van Groningen's avatar John van Groningen
Browse files

remove remaining unused functions for printing types in typeconv_2.c

parent a372be72
extern void InitARC_Info (void);
extern void PrintTypeClass (SymbDef class_def, File file);
/*
Version 1.0 26/08/1994
Author: Sjaak Smetsers
*/
#define STATES_GENERATED
#define STORE_UNIQUE_ATTRIBUTES_IN_TYPE_NODES
#include "compiledefines.h"
#include "types.t"
#include "system.h"
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
#include "scanner.h"
#include "comparser.h"
#include "sizes.h"
#include "checker.h"
#include "transform.h"
#include "sa.h"
#include "tcsupport.h"
#include "typeconv.h"
#include "checksupport.h"
#include "statesgen.h"
#include "buildtree.h"
typedef
struct attr_ref_count_info
{ BITVECT arci_used;
BITVECT arci_multiply_used;
BITVECT arci_implicitly_attributed;
struct attr_ref_count_info * arci_next;
} * ARC_Info;
static ARC_Info CurrentARC_Info;
static char *TypeConv = "typeconv";
static unsigned RetrieveRefCountInfo (int attr_var, Bool *used_implicitly)
{
ARC_Info attrinfo = CurrentARC_Info;
unsigned newnumber = 0;
int i;
while (attr_var >= 32)
{ attr_var -= 32;
for (i = 0; i < 32; i++)
{ if (BITTEST (attrinfo -> arci_multiply_used, i))
newnumber++;
}
attrinfo = attrinfo -> arci_next;
Assume (attrinfo != NULL, TypeConv, "RetrieveRefCountInfo");
}
if (BITTEST (attrinfo -> arci_multiply_used, attr_var))
{ for (i = 0; i < attr_var; i++)
{ if (BITTEST (attrinfo -> arci_multiply_used, i))
newnumber++;
}
*used_implicitly = False;
return newnumber + 1;
}
else
{ *used_implicitly = BITTEST (attrinfo -> arci_implicitly_attributed, attr_var);
return 0;
}
} /* RetrieveRefCountInfo */
static char *PrintVars = "abcdefghijklmnopqrst";
#define NrOfPrintVars 20
static char *PrintUniVars = "uvwxyz";
#define NrOfPrintUniVars 6
#define cDoPrintAnnot True
#define cDontPrintAnnot False
static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool print_annot);
static unsigned RetrieveRefCountInfo (int attr_var, Bool *used_implicitly);
static void PrintAttributeVariable (unsigned attr_nr)
{
if (attr_nr <= NrOfPrintUniVars)
FPrintF (StdListTypes, "%c", PrintUniVars [attr_nr - 1]);
else
FPrintF (StdListTypes, "u%d", attr_nr - NrOfPrintUniVars);
} /* PrintAttributeVariable */
extern Bool DoShowAttributes;
#define cDoPrintColon True
static Bool PrintAttribute (AttributeKind attr, Bool print_colon)
{
if (attr == UniqueAttr)
{ FPutC ('*', StdListTypes);
return True;
}
else if (DoShowAttributes)
{ Bool used_implicitly;
unsigned attr_nr = RetrieveRefCountInfo (attr - FirstUniVarNumber, & used_implicitly);
if (attr_nr == 0)
{ if (! used_implicitly)
{ FPutC ('.', StdListTypes);
return True;
}
else
return False;
}
else
{ PrintAttributeVariable (attr_nr);
if (print_colon)
FPutC (':', StdListTypes);
return True;
}
}
else
return False;
} /* PrintAttribute */
#define cDoPrintAttribute True
#define cDontPrintAttribute False
#define cInAStrictContext True
#define cNotInAStrictContext False
#define cPrintBrackets True
#define cDontPrintBrackets False
static void PrintArgument (TypeArgs arg, Bool brackets, Bool strict_context, Bool print_attribute)
{
if (arg -> type_arg_node -> type_node_is_var)
{ if (strict_context)
#ifdef STATES_GENERATED
# if 1
strict_context = arg -> type_arg_node -> type_node_annotation==StrictAnnot;
# else
strict_context = !IsLazyState (arg -> type_arg_node -> type_node_state);
# endif
#else
strict_context = arg -> type_arg_node -> type_node_state.state_kind == StrictOnA;
#endif
if ( strict_context && (DoListAllTypes || DoListStrictTypes) &&
#ifdef STATES_GENERATED
# if 1
arg -> type_arg_node -> type_node_annotation==StrictAnnot)
# else
!IsLazyState (arg -> type_arg_node -> type_node_state))
# endif
#else
arg -> type_arg_node -> type_node_state.state_kind == StrictOnA)
#endif
FPutC ('!', StdListTypes);
if (print_attribute && arg -> type_arg_node -> type_node_attribute > NoAttr)
PrintAttribute (arg -> type_arg_node -> type_node_attribute, arg -> type_arg_node -> type_node_tv != NULL);
if (arg -> type_arg_node -> type_node_tv)
{ if (arg -> type_arg_node -> type_node_tv -> tv_ident)
FPutS (arg -> type_arg_node -> type_node_tv -> tv_ident -> ident_name, StdListTypes);
else
FPrintF (StdListTypes, "i%ld", arg -> type_arg_node -> type_node_tv);
}
}
else
PrintNode (arg -> type_arg_node, brackets, strict_context, cDoPrintAnnot);
} /* PrintArgument */
static void PrintArguments (TypeArgs args, char separator, Bool brackets, Bool strict_context, FlatType form_type)
{
if (args)
{ int arg_nr;
TypeVarList form_type_vars;
if (form_type != NULL)
{ form_type_vars = form_type -> ft_arguments;
PrintArgument (args, brackets, strict_context, ! TestMark (form_type_vars -> tvl_elem, tv_mark, TV_EXISTENTIAL_ATTRIBUTE_MASK));
form_type_vars = form_type_vars -> tvl_next;
}
else
{ form_type_vars = NULL;
PrintArgument (args, brackets, strict_context, cDoPrintAttribute);
}
for (arg_nr = 1, args = args -> type_arg_next; args; args = args -> type_arg_next, arg_nr++)
{ FPutC (separator, StdListTypes);
if (form_type_vars != NULL)
{ PrintArgument (args, brackets, strict_context, ! TestMark (form_type_vars -> tvl_elem, tv_mark, TV_EXISTENTIAL_ATTRIBUTE_MASK));
form_type_vars = form_type_vars -> tvl_next;
}
else
PrintArgument (args, brackets, strict_context, cDoPrintAttribute);
}
}
} /* PrintArguments */
#ifdef CLEAN2
static void PrintTypeVarList (TypeVarList type_vars)
{
for (; type_vars != NULL; type_vars = type_vars -> tvl_next)
{
/* RWS:
Printing the attributes currently works because the attributes for
universally quantified type variables can only be none, '*' or '.'.
For attribute variables something should probably done with the
CurrentARC_Info administration, but I don't understand how this works.
*/
if (type_vars -> tvl_attribute != NoUniAttr)
PrintAttribute (type_vars -> tvl_attribute, cDoPrintColon);
FPutS (type_vars -> tvl_elem -> tv_ident -> ident_name, StdListTypes);
if (type_vars -> tvl_next != NULL)
FPutC (' ', StdListTypes);
}
}
#endif
static FlatType RetrieveLhsOfTypeDefinition (SymbDef tdef)
{
switch (tdef -> sdef_kind)
{
case TYPE:
case RECORDTYPE:
return tdef -> sdef_type != NULL ? tdef -> sdef_type -> type_lhs : NULL;
case TYPESYN:
return tdef -> sdef_syn_type -> syn_lhs;
break;
case ABSTYPE:
return tdef -> sdef_abs_type -> abs_graph;
break;
default:
return NULL;
}
} /* RetrieveLhsOfTypeDefinition */
static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool print_annot)
{
if (print_annot && strict_context && (DoListAllTypes || DoListStrictTypes) &&
#ifdef STATES_GENERATED
# if 1
node -> type_node_annotation==StrictAnnot)
# else
!IsLazyState (node -> type_node_state))
# endif
#else
node -> type_node_state.state_kind == StrictOnA)
#endif
FPutC ('!', StdListTypes);
if (node -> type_node_attribute > NoAttr)
{ if (PrintAttribute (node -> type_node_attribute, cDoPrintColon) &&
(node -> type_node_symbol -> symb_kind == fun_type || node -> type_node_symbol -> symb_kind == apply_symb))
brackets = True;
}
#ifdef CLEAN2
if (node -> type_for_all_vars != NULL)
{ FPutS ("(A.", StdListTypes);
PrintTypeVarList (node -> type_for_all_vars);
FPutC (':', StdListTypes);
brackets = False;
}
#endif
switch (node -> type_node_symbol -> symb_kind)
{
case tuple_type:
{ int form_arity = node -> type_node_symbol -> symb_arity;
if (node -> type_node_arity == form_arity)
{ FPutC ('(', StdListTypes);
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, strict_context, NULL);
FPutC (')', StdListTypes);
}
else
{ int i;
if (brackets && node -> type_node_arguments)
FPutC ('(', StdListTypes);
FPutC ('(', StdListTypes);
for (i=1; i<form_arity; i++)
FPutC (',', StdListTypes);
FPutC (')', StdListTypes);
if (node -> type_node_arguments)
{ PrintArguments (node -> type_node_arguments, ' ', cPrintBrackets, strict_context, NULL);
if (brackets)
FPutC (')', StdListTypes);
}
}
break;
}
case list_type:
FPutC ('[', StdListTypes);
#if STRICT_LISTS
if (node->type_node_symbol->symb_head_strictness==2)
FPutC ('!', StdListTypes);
else if (node->type_node_symbol->symb_head_strictness==3 || node->type_node_symbol->symb_head_strictness==4)
FPutC ('#', StdListTypes);
#endif
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cNotInAStrictContext, NULL);
#if STRICT_LISTS
if (node->type_node_symbol->symb_tail_strictness)
FPutC ('!', StdListTypes);
#endif
FPutC (']', StdListTypes);
break;
case array_type:
FPutS ("{", StdListTypes);
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cInAStrictContext, NULL);
FPutS ("}", StdListTypes);
break;
case strict_array_type:
FPutS ("{!", StdListTypes);
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cInAStrictContext, NULL);
FPutS ("}", StdListTypes);
break;
case unboxed_array_type:
FPutS ("{#", StdListTypes);
PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cInAStrictContext, NULL);
FPutS ("}", StdListTypes);
break;
case fun_type:
{ TypeNode arg_type_node = node -> type_node_arguments -> type_arg_node;
if (brackets)
FPutC ('(', StdListTypes);
PrintArgument (node -> type_node_arguments, cPrintBrackets, cNotInAStrictContext, cDoPrintAttribute);
FPutS (" -> ", StdListTypes);
PrintArgument (node -> type_node_arguments -> type_arg_next, cDontPrintBrackets, cNotInAStrictContext, cDoPrintAttribute);
if (brackets)
FPutC (')', StdListTypes);
break;
}
case apply_symb:
if (brackets)
FPutC ('(', StdListTypes);
PrintArguments (node -> type_node_arguments, ' ', cPrintBrackets, strict_context, NULL);
if (brackets)
FPutC (')', StdListTypes);
break;
default:
if (brackets && node -> type_node_arguments)
FPutC ('(', StdListTypes);
PrintSymbol (node -> type_node_symbol, StdListTypes);
if (node -> type_node_arguments)
{ FlatType lhs_type;
if (node -> type_node_symbol -> symb_kind == definition)
lhs_type = RetrieveLhsOfTypeDefinition (node -> type_node_symbol -> symb_def);
else
lhs_type = NULL;
FPutC (' ', StdListTypes);
PrintArguments (node -> type_node_arguments,' ', cPrintBrackets, strict_context, lhs_type);
if (brackets)
FPutC (')', StdListTypes);
}
break;
}
#ifdef CLEAN2
if (node -> type_for_all_vars != NULL)
FPutC (')', StdListTypes);
#endif
} /* PrintNode */
static void PrintAttributeEquations (UniVarEquations attr_equas)
{
FPutS (", [", StdListTypes);
for ( ; ; )
{ AttributeKindList next;
Bool used_implicitly;
unsigned dem_attr_nr = RetrieveRefCountInfo (attr_equas -> uve_demanded - FirstUniVarNumber, & used_implicitly);
for (next = attr_equas -> uve_offered ; ; )
{ unsigned off_attr_nr = RetrieveRefCountInfo (next -> akl_elem - FirstUniVarNumber, & used_implicitly);
PrintAttributeVariable (off_attr_nr);
if ((next = next -> akl_next))
FPutC (' ', StdListTypes);
else
break;
}
FPutS (" <= ", StdListTypes);
PrintAttributeVariable (dem_attr_nr);
if ((attr_equas = attr_equas -> uve_next))
FPutS (", ", StdListTypes);
else
break;
}
FPutC (']', StdListTypes);
} /* PrintAttributeEquations */
#include <ctype.h>
void PrintTypeClass (SymbDef class_def, File file)
{
char * class_name = class_def -> sdef_ident -> ident_name;
if (*class_name == '.')
class_name++;
FPutS (class_name, file);
} /* PrintTypeClass */
static void PrintTypeContext (TypeContext context)
{
SymbolList class_symbs = context -> tyco_symbols;
TypeVar context_var = context -> tyco_variable;
PrintTypeClass (class_symbs -> sl_symbol, StdListTypes);
for (class_symbs = class_symbs -> sl_next; class_symbs; class_symbs = class_symbs -> sl_next)
{ FPutS (" , ", StdListTypes);
PrintTypeClass (class_symbs -> sl_symbol, StdListTypes);
}
FPutC (' ', StdListTypes);
if (TestMark (context_var, tv_mark, TV_WITH_INST_RESTR))
FPutC ('.', StdListTypes);
FPutS (context_var -> tv_ident -> ident_name, StdListTypes);
} /* PrintTypeContext */
void InitARC_Info (void)
{
CurrentARC_Info = CompAllocType (struct attr_ref_count_info);
CurrentARC_Info -> arci_next = NULL;
} /* InitARC_Info */
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment