Commit 81bf4d1c authored by John van Groningen's avatar John van Groningen
Browse files

No commit message

No commit message
parent 3abff7de
...@@ -2518,7 +2518,6 @@ DeclareFunctionC (char *name, int arity, int functionIndex, unsigned int ancesto ...@@ -2518,7 +2518,6 @@ DeclareFunctionC (char *name, int arity, int functionIndex, unsigned int ancesto
newSymbDef->sdef_dcl_icl = NULL; newSymbDef->sdef_dcl_icl = NULL;
newSymbDef->sdef_isused = 0; newSymbDef->sdef_isused = 0;
newSymbDef->sdef_nr_of_lifted_nodeids = 0; /* used in PrintType */
newSymbDef->sdef_line = 0; /* used in PrintType */ newSymbDef->sdef_line = 0; /* used in PrintType */
*icl->beicl_depsP = newSymbDef; *icl->beicl_depsP = newSymbDef;
......
...@@ -64,7 +64,7 @@ NewArgument (NodeP node) ...@@ -64,7 +64,7 @@ NewArgument (NodeP node)
newarg = CompAllocType (ArgS); newarg = CompAllocType (ArgS);
newarg->arg_node = node; newarg->arg_node = node;
newarg->arg_occurrence = NotUsed; newarg->arg_occurrence = 0;
newarg->arg_next = NIL; newarg->arg_next = NIL;
return (newarg); return (newarg);
......
...@@ -132,7 +132,6 @@ SymbDef MakeNewSymbolDefinition (char * module, Ident name, int arity, SDefKind ...@@ -132,7 +132,6 @@ SymbDef MakeNewSymbolDefinition (char * module, Ident name, int arity, SDefKind
def->sdef_mark=0; def->sdef_mark=0;
def->sdef_exported=False; def->sdef_exported=False;
def->sdef_main_dcl=False;
def->sdef_arfun = NoArrayFun; def->sdef_arfun = NoArrayFun;
......
...@@ -425,36 +425,6 @@ void CheckError (char *msg1,char *msg2) ...@@ -425,36 +425,6 @@ void CheckError (char *msg1,char *msg2)
StaticMessage (True,"%S","%s %s",CurrentSymbol,msg1,msg2); StaticMessage (True,"%S","%s %s",CurrentSymbol,msg1,msg2);
} }
void CheckNodeError (char *msg1,char *msg2,NodeP node_p)
{
if (node_p->node_line>=0){
unsigned old_CurrentLine;
old_CurrentLine=CurrentLine;
CurrentLine=node_p->node_line;
StaticMessage (True,"%S","%s %s",CurrentSymbol,msg1,msg2);
CurrentLine=old_CurrentLine;
} else
StaticMessage (True,"%S","%s %s",CurrentSymbol,msg1,msg2);
}
void CheckNodeSymbolError (struct symbol *symbol,char *msg,NodeP node_p)
{
if (node_p->node_line>=0){
unsigned old_CurrentLine;
old_CurrentLine=CurrentLine;
CurrentLine=node_p->node_line;
StaticMessage (True,"%S","%S %s",CurrentSymbol,symbol,msg);
CurrentLine=old_CurrentLine;
} else
StaticMessage (True,"%S","%S %s",CurrentSymbol,symbol,msg);
}
void CheckSymbolError (struct symbol *symbol,char *msg) void CheckSymbolError (struct symbol *symbol,char *msg)
{ {
StaticMessage (True,"%S","%S %s",CurrentSymbol,symbol,msg); StaticMessage (True,"%S","%S %s",CurrentSymbol,symbol,msg);
......
...@@ -6,8 +6,6 @@ ...@@ -6,8 +6,6 @@
extern char *ConvertSymbolKindToString (SymbKind skind); extern char *ConvertSymbolKindToString (SymbKind skind);
extern void CheckError (char *msg1,char *msg2); extern void CheckError (char *msg1,char *msg2);
extern void CheckNodeError (char *msg1,char *msg2,NodeP node_p);
extern void CheckNodeSymbolError (struct symbol *symbol,char *msg,NodeP node_p);
extern void CheckSymbolError (struct symbol *symbol,char *msg); extern void CheckSymbolError (struct symbol *symbol,char *msg);
extern void CheckWarning (char *msg1,char *msg2); extern void CheckWarning (char *msg1,char *msg2);
extern void CheckSymbolWarning (struct symbol *symbol,char *msg); extern void CheckSymbolWarning (struct symbol *symbol,char *msg);
......
...@@ -758,9 +758,6 @@ static void CodeRule (ImpRuleP rule) ...@@ -758,9 +758,6 @@ static void CodeRule (ImpRuleP rule)
rule_sdef->sdef_dcl_icl->sdef_rule_type->rule_type_state_p,rule->rule_state_p, rule_sdef->sdef_dcl_icl->sdef_rule_type->rule_type_state_p,rule->rule_state_p,
jmp_to_eval_args_entry,init_a_stack_top, init_b_stack_top, &ea_lab, &extlab, root_node_needed); jmp_to_eval_args_entry,init_a_stack_top, init_b_stack_top, &ea_lab, &extlab, root_node_needed);
break; break;
case INSTANCE:
ext_label_needed=True;
break;
default: default:
ErrorInCompiler ("codegen.c","CodeRule","unknown kind of rewrite rule"); ErrorInCompiler ("codegen.c","CodeRule","unknown kind of rewrite rule");
break; break;
...@@ -1295,9 +1292,6 @@ void CodeGeneration (ImpMod imod, char *fname) ...@@ -1295,9 +1292,6 @@ void CodeGeneration (ImpMod imod, char *fname)
WriteLastNewlineToABCFile(); WriteLastNewlineToABCFile();
CloseABCFile (fname); CloseABCFile (fname);
#ifdef _COMPSTATS_
PrintCompStats();
#endif
} }
} }
} }
...@@ -640,9 +640,6 @@ void InitCompiler (void) ...@@ -640,9 +640,6 @@ void InitCompiler (void)
InitStatesGen (); InitStatesGen ();
InitCoding (); InitCoding ();
InitInstructions (); InitInstructions ();
#ifdef _COMPSTATS_
InitDB ();
#endif
oldhandler = SetSignal (SetInterruptFlag); oldhandler = SetSignal (SetInterruptFlag);
} /* InitCompiler */ } /* InitCompiler */
......
...@@ -77,18 +77,6 @@ void PrintState (StateS state, File file) ...@@ -77,18 +77,6 @@ void PrintState (StateS state, File 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) void DPrintNodeId (NodeId nid, File file)
{ {
if (nid){ if (nid){
...@@ -138,10 +126,8 @@ static void PrintArgument (Args arg,Bool brackets,int n_leading_spaces,File file ...@@ -138,10 +126,8 @@ static void PrintArgument (Args arg,Bool brackets,int n_leading_spaces,File file
if (arg->arg_node->node_kind==NodeIdNode) if (arg->arg_node->node_kind==NodeIdNode)
DPrintNodeId (arg->arg_node->node_node_id,file); DPrintNodeId (arg->arg_node->node_node_id,file);
else { else
/* DPrintOccurrenceKind (arg -> arg_occurrence); */
PrintRuleNode (arg->arg_node,brackets,n_leading_spaces,file); PrintRuleNode (arg->arg_node,brackets,n_leading_spaces,file);
}
} }
static void print_spaces (int n_leading_spaces,File file) static void print_spaces (int n_leading_spaces,File file)
...@@ -541,11 +527,7 @@ void PrintNodeDef (NodeDefP def_p,int n_leading_spaces,File file) ...@@ -541,11 +527,7 @@ void PrintNodeDef (NodeDefP def_p,int n_leading_spaces,File file)
for (n=n_leading_spaces; n>0; --n) for (n=n_leading_spaces; n>0; --n)
FPutC (' ',file); FPutC (' ',file);
/* if (def_p->def_has_lhs_pattern) DPrintNodeId (def_p -> def_id, file);
PrintRuleNode (def_p->def_pattern,False,n_leading_spaces,file);
else
*/
DPrintNodeId (def_p -> def_id, file);
if (def_p -> def_node){ if (def_p -> def_node){
FPutS (" = ", file); FPutS (" = ", file);
...@@ -797,42 +779,3 @@ void PrintRules (ImpRules rules,File file) ...@@ -797,42 +779,3 @@ void PrintRules (ImpRules rules,File file)
FPutC ('\n',file); FPutC ('\n',file);
} }
} }
#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
#undef _COMPSTATS_
extern void PrintRuleNode (Node node,Bool brackets,int n_leading_spaces,File file); extern void PrintRuleNode (Node node,Bool brackets,int n_leading_spaces,File file);
extern void PrintRuleAlt (RuleAlts rulealt,int n_leading_spaces,File file); extern void PrintRuleAlt (RuleAlts rulealt,int n_leading_spaces,File file);
extern void PrintNodeDef (NodeDefP def_p,int n_leading_spaces,File file); extern void PrintNodeDef (NodeDefP def_p,int n_leading_spaces,File file);
...@@ -9,25 +7,7 @@ extern void PrintImpRule (ImpRules rule,int n_leading_spaces,File file); ...@@ -9,25 +7,7 @@ extern void PrintImpRule (ImpRules rule,int n_leading_spaces,File file);
extern void PrintTypeNode (TypeNode node, File file); extern void PrintTypeNode (TypeNode node, File file);
extern void DPrintNodeId (NodeId nid, File file); extern void DPrintNodeId (NodeId nid, File file);
extern void DPrintNodeIdS (char *s,NodeId nid, File file); extern void DPrintNodeIdS (char *s,NodeId nid, File file);
extern void DPrintOccurrenceKind (OccurrenceKind kind, File file);
extern void PrintTypeAlt (TypeAlts type_alts, File file, Bool with_equats); extern void PrintTypeAlt (TypeAlts type_alts, File file, Bool with_equats);
extern void PrintState (StateS state, File file); extern void PrintState (StateS state, File file);
extern void PrintRules (ImpRules rules,File file); extern void PrintRules (ImpRules rules,File file);
#ifdef _COMPSTATS_
extern unsigned long
NrNodeCells,
NrArgCells,
NrTypeNodeCells,
NrTypeArgCells,
NrExpandedTypeNodeCells,
NrExpandedTypeArgCells,
NrNodeIdCells,
NrSymbolCells,
NrBasicNodes;
extern void InitDB (void);
extern void PrintCompStats (void);
#endif
\ No newline at end of file
/*
Version 1.0 08/25/1994
Author: Sjaak Smetsers
*/
/*
typedef struct member_descriptor
{
SymbDef md_class;
Symbol md_rule;
} * MemberDescriptor;
typedef struct member_item
{
Bool mi_is_class;
union
{ Overloaded mi_u_rule;
SymbDef mi_u_class;
} mi_union;
struct member_item * mi_next;
} * MemberItems;
#define mi_rule mi_union.mi_u_rule
#define mi_class mi_union.mi_u_class
*/
/*
Global variables
*/
extern unsigned NrOfOverloadedTypeVars, NrOfOverloadedRules, NrOfUntypedImpRules,
NrOfTypeClasses;
/*
Global functions
*/
extern int LengthOfPolyList (PolyList list);
extern PolyList NewPolyListElem (void *elem, PolyList next, HeapDescr hd);
extern Bool IsSubClass (SymbolList sub_tree, SymbolList whole_list);
extern void DetermineClassesOfOverloadedTypeVariables (struct type_cell * type_inst);
extern Bool TryToBindOverloadedTypeVariables (Node appl_node, SymbolList class_symbols, struct type_cell * type_inst);
extern void CheckInstancesOfTypeClasses (Symbol symbs);
extern void ConvertTypeClasses (void);
extern void ConvertTypeContexts (TypeContext type_cont, struct type_cell * typeargs []);
extern void SetOverloadedTypeVars (int over_arity, TypeContext type_cont, struct type_cell * over_vars []);
extern void DetermineClassNumber (SymbDef class_symb);
extern SymbDef CopySymbDef (SymbDef old);
extern SymbDef NewEmptyRule (Symbol rule_symb, int arity, unsigned line);
extern Bool EqualTypeClasses (int var_nr1, int var_nr2);
extern void InitOverloading (void);
extern FieldList RetrieveClassSelector (SymbolList class_symbols, SymbDef class_symbol);
extern Types DetermineClassRecord (int nr_of_fields);
extern Bool InstanceIsExported (struct type_cell * inst_types [], struct type_cell * over_vars [], TypeContext type_cont);
extern struct type_cell * DetermineDefaultInstance (struct type_cell * over_var, Node over_appl_node);
extern Bool EqualSymbolList (SymbolList class_symbols1, SymbolList class_symbols2);
extern Bool ClassesHaveAGenericInstance (SymbolList classes);
extern struct type_cell * DetermineGenericInstance (struct type_cell * over_var);
extern SymbolList RebuildClassSymbolList (SymbolList class_symbs, void *alloc (SizeT size));
#define cTakeIclDef True
#define cDontTakeIclDef False
extern void InsertSymbolInSymbolList (SymbolList *symbols, SymbDef new_symbol, Bool take_icl_def, void *alloc (SizeT size));
extern void ConvertClassSymbolTreeToList (SymbolList symbols, SymbolList * result_list, void *alloc (SizeT size));
extern void CreateRuleType (SymbDef icl_def, TypeAlts imp_type);
/*
Version 1.0 - 24 okt 1994
Author: Sjaak Smetsers
*/
#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 "checksupport.h"
#include "transform.h"
#include "sa.h"
#include "statesgen.h"
#include "tctypes.t"
#include "typechecker.h"
#include "typechecker2.h"
#include "typeconv.h"
#include "tcsupport.h"
#include "refcountanal.h"
#include "overloading.h"
#include "buildtree.h"
#ifdef _DEBUG_
static char *OV = "overloading";
#endif
PolyList NewPolyListElem (void *elem, PolyList next, HeapDescr hd)
{
PolyList new = TH_AllocType (hd, struct poly_list);
new -> pl_elem = elem;
new -> pl_next = next;
return new;
} /* NewPolyListElem */
void InsertSymbolInSymbolList (SymbolList *symbols, SymbDef new_symbol, Bool take_icl_def, void *alloc (SizeT size))
{
SymbolList new_elem;
for (; *symbols; symbols = & (*symbols) -> sl_next)
{ int cmp = strcmp ((*symbols) -> sl_symbol -> sdef_ident -> ident_name, new_symbol -> sdef_ident -> ident_name);
if (cmp == 0)
return;
else if (cmp > 0)
break;
}
new_elem = (SymbolListS *) alloc (SizeOf (SymbolListS));
if (take_icl_def && new_symbol -> sdef_main_dcl)
new_elem -> sl_symbol = new_symbol -> sdef_dcl_icl;
else
new_elem -> sl_symbol = new_symbol;
new_elem -> sl_kind = SLK_Symbol;
new_elem -> sl_next = *symbols;
*symbols = new_elem;
} /* InsertSymbolInSymbolList */
void ConvertClassSymbolTreeToList (SymbolList symbols, SymbolList * result_list, void *alloc (SizeT size))
{
SymbolList next_symbol;
for (next_symbol = symbols; next_symbol -> sl_kind == SLK_TreeOfLists; next_symbol = next_symbol -> sl_next_tree)
ConvertClassSymbolTreeToList (next_symbol -> sl_next, result_list, alloc);
if (next_symbol -> sl_kind == SLK_ListNumber)
next_symbol = next_symbol -> sl_next;
for (; next_symbol; next_symbol = next_symbol -> sl_next)
InsertSymbolInSymbolList (result_list, next_symbol -> sl_symbol, cTakeIclDef, alloc);
} /* ConvertClassSymbolTreeToList */
...@@ -2277,9 +2277,6 @@ static Exp ConvertNode (Node node, NodeId nid) ...@@ -2277,9 +2277,6 @@ static Exp ConvertNode (Node node, NodeId nid)
sdef = node->node_symbol->symb_def; sdef = node->node_symbol->symb_def;
if (sdef->sdef_kind == INSTANCE)
DoFatalError ("Strictness analysis (ConvertNode): instance encounterred");
if (sdef->sdef_kind==DEFRULE || sdef->sdef_kind==SYSRULE){ if (sdef->sdef_kind==DEFRULE || sdef->sdef_kind==SYSRULE){
TypeAlts rule; TypeAlts rule;
TypeArgs typeargs; TypeArgs typeargs;
...@@ -2604,9 +2601,6 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i ...@@ -2604,9 +2601,6 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i
sdef = symbol_p->symb_def; sdef = symbol_p->symb_def;
if (sdef->sdef_kind == INSTANCE)
DoFatalError ("Strictness analysis (convert_pattern): instance encounterred");
if (sdef->sdef_kind==DEFRULE || sdef->sdef_kind==SYSRULE){ if (sdef->sdef_kind==DEFRULE || sdef->sdef_kind==SYSRULE){
TypeAlts rule; TypeAlts rule;
TypeArgs typeargs; TypeArgs typeargs;
......
...@@ -49,7 +49,6 @@ NewIdent (TableKind tableKind, char *name) ...@@ -49,7 +49,6 @@ NewIdent (TableKind tableKind, char *name)
ident->ident_next = NULL; ident->ident_next = NULL;
ident->ident_environ = NULL; ident->ident_environ = NULL;
ident->ident_symbol = NULL; ident->ident_symbol = NULL;
ident->ident_local_defs = NULL;
ident->ident_mark = 0; ident->ident_mark = 0;
return (ident); return (ident);
......
...@@ -1099,7 +1099,7 @@ void ExamineTypesAndLhsOfImpRuleSymbolDefinitionAgain (SymbDef def) ...@@ -1099,7 +1099,7 @@ void ExamineTypesAndLhsOfImpRuleSymbolDefinitionAgain (SymbDef def)
DetermineLhsStatesOfRule (def->sdef_rule); DetermineLhsStatesOfRule (def->sdef_rule);
#endif #endif
if (def->sdef_exported && def->sdef_dcl_icl!=NULL && def->sdef_dcl_icl->sdef_kind!=INSTANCE) if (def->sdef_exported && def->sdef_dcl_icl!=NULL)
rootstate=def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p[-1]; rootstate=def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p[-1];
if (IsSimpleState (rootstate)){ if (IsSimpleState (rootstate)){
...@@ -1148,7 +1148,7 @@ void ExamineTypesAndLhsOfSymbolDefinition (SymbDef def) ...@@ -1148,7 +1148,7 @@ void ExamineTypesAndLhsOfSymbolDefinition (SymbDef def)
def->sdef_rule->rule_state_p = allocate_function_state (def->sdef_arity); def->sdef_rule->rule_state_p = allocate_function_state (def->sdef_arity);
rootstate = DetermineStatesOfRuleType (def->sdef_rule->rule_type,def->sdef_rule->rule_state_p); rootstate = DetermineStatesOfRuleType (def->sdef_rule->rule_type,def->sdef_rule->rule_state_p);
if (def->sdef_exported && def->sdef_dcl_icl!=NULL && def->sdef_dcl_icl->sdef_kind!=INSTANCE){ if (def->sdef_exported && def->sdef_dcl_icl!=NULL){
def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p = allocate_function_state (def->sdef_arity); def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p = allocate_function_state (def->sdef_arity);
rootstate = DetermineStatesOfRuleType (def->sdef_dcl_icl->sdef_rule_type->rule_type_rule,def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p); rootstate = DetermineStatesOfRuleType (def->sdef_dcl_icl->sdef_rule_type->rule_type_rule,def->sdef_dcl_icl->sdef_rule_type->rule_type_state_p);
} }
......
...@@ -4,7 +4,6 @@ ...@@ -4,7 +4,6 @@
#include "compiledefines.h" #include "compiledefines.h"
#define class class_is_keyword
#define new new_is_keyword #define new new_is_keyword
#define STRUCT(struct_name,type_name) \ #define STRUCT(struct_name,type_name) \
...@@ -19,10 +18,6 @@ typedef enum ...@@ -19,10 +18,6 @@ typedef enum
{ NoAttr, DeferAttr, CopyAttr { NoAttr, DeferAttr, CopyAttr
} GraphAttributeKind; } GraphAttributeKind;
typedef enum
{ NotUsed, UniquelyUsed, SelectivelyUsed, MultiplyUsed, ObservinglyUsed
} OccurrenceKind;
typedef enum { typedef enum {
TupleState, ArrayState, RecordState, SimpleState TupleState, ArrayState, RecordState, SimpleState
} StateType; } StateType;
...@@ -193,15 +188,6 @@ STRUCT(ident,Ident){ ...@@ -193,15 +188,6 @@ STRUCT(ident,Ident){
char * ident_u1_instructions; char * ident_u1_instructions;
} ident_union1; } ident_union1;
#ifdef SHORT_CLASS_NAMES
union{
struct local_def * ident_u2_local_defs;
struct module_info * ident_u2_mod_info;
} ident_union2;
#else
struct local_def * ident_local_defs;
#endif
struct ident * ident_next; struct ident * ident_next;
unsigned char ident_table; /* TableKind */ unsigned char ident_table; /* TableKind */
unsigned char ident_mark; unsigned char ident_mark;
...@@ -212,11 +198,6 @@ STRUCT(ident,Ident){ ...@@ -212,11 +198,6 @@ STRUCT(ident,Ident){
#define ident_tv ident_union1.ident_u1_tv #define ident_tv ident_union1.ident_u1_tv
#define ident_uni_var ident_union1.ident_u1_uni_var #define ident_uni_var ident_union1.ident_u1_uni_var
#define ident_instructions ident_union1.ident_u1_instructions #define ident_instructions ident_union1.ident_u1_instructions
#ifdef SHORT_CLASS_NAMES
#define ident_local_defs ident_union2.ident_u2_local_defs
#define ident_mod_info ident_union2.ident_u2_mod_info