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
newSymbDef->sdef_dcl_icl = NULL;
newSymbDef->sdef_isused = 0;
newSymbDef->sdef_nr_of_lifted_nodeids = 0; /* used in PrintType */
newSymbDef->sdef_line = 0; /* used in PrintType */
*icl->beicl_depsP = newSymbDef;
......
......@@ -64,7 +64,7 @@ NewArgument (NodeP node)
newarg = CompAllocType (ArgS);
newarg->arg_node = node;
newarg->arg_occurrence = NotUsed;
newarg->arg_occurrence = 0;
newarg->arg_next = NIL;
return (newarg);
......
......@@ -132,7 +132,6 @@ SymbDef MakeNewSymbolDefinition (char * module, Ident name, int arity, SDefKind
def->sdef_mark=0;
def->sdef_exported=False;
def->sdef_main_dcl=False;
def->sdef_arfun = NoArrayFun;
......
......@@ -425,36 +425,6 @@ void CheckError (char *msg1,char *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)
{
StaticMessage (True,"%S","%S %s",CurrentSymbol,symbol,msg);
......
......@@ -6,8 +6,6 @@
extern char *ConvertSymbolKindToString (SymbKind skind);
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 CheckWarning (char *msg1,char *msg2);
extern void CheckSymbolWarning (struct symbol *symbol,char *msg);
......
......@@ -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,
jmp_to_eval_args_entry,init_a_stack_top, init_b_stack_top, &ea_lab, &extlab, root_node_needed);
break;
case INSTANCE:
ext_label_needed=True;
break;
default:
ErrorInCompiler ("codegen.c","CodeRule","unknown kind of rewrite rule");
break;
......@@ -1295,9 +1292,6 @@ void CodeGeneration (ImpMod imod, char *fname)
WriteLastNewlineToABCFile();
CloseABCFile (fname);
#ifdef _COMPSTATS_
PrintCompStats();
#endif
}
}
}
......@@ -640,9 +640,6 @@ void InitCompiler (void)
InitStatesGen ();
InitCoding ();
InitInstructions ();
#ifdef _COMPSTATS_
InitDB ();
#endif
oldhandler = SetSignal (SetInterruptFlag);
} /* InitCompiler */
......
......@@ -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)
{
if (nid){
......@@ -138,10 +126,8 @@ static void PrintArgument (Args arg,Bool brackets,int n_leading_spaces,File file
if (arg->arg_node->node_kind==NodeIdNode)
DPrintNodeId (arg->arg_node->node_node_id,file);
else {
/* DPrintOccurrenceKind (arg -> arg_occurrence); */
else
PrintRuleNode (arg->arg_node,brackets,n_leading_spaces,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)
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);
DPrintNodeId (def_p -> def_id, file);
if (def_p -> def_node){
FPutS (" = ", file);
......@@ -797,42 +779,3 @@ void PrintRules (ImpRules rules,File 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 PrintRuleAlt (RuleAlts rulealt,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);
extern void PrintTypeNode (TypeNode node, File file);
extern void DPrintNodeId (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 PrintState (StateS state, 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)
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){
TypeAlts rule;
TypeArgs typeargs;
......@@ -2604,9 +2601,6 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i
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){
TypeAlts rule;
TypeArgs typeargs;
......
......@@ -49,7 +49,6 @@ NewIdent (TableKind tableKind, char *name)
ident->ident_next = NULL;
ident->ident_environ = NULL;
ident->ident_symbol = NULL;
ident->ident_local_defs = NULL;
ident->ident_mark = 0;
return (ident);
......
......@@ -1099,7 +1099,7 @@ void ExamineTypesAndLhsOfImpRuleSymbolDefinitionAgain (SymbDef def)
DetermineLhsStatesOfRule (def->sdef_rule);
#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];
if (IsSimpleState (rootstate)){
......@@ -1148,7 +1148,7 @@ void ExamineTypesAndLhsOfSymbolDefinition (SymbDef def)
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);
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);
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 @@
#include "compiledefines.h"
#define class class_is_keyword
#define new new_is_keyword
#define STRUCT(struct_name,type_name) \
......@@ -19,10 +18,6 @@ typedef enum
{ NoAttr, DeferAttr, CopyAttr
} GraphAttributeKind;
typedef enum
{ NotUsed, UniquelyUsed, SelectivelyUsed, MultiplyUsed, ObservinglyUsed
} OccurrenceKind;
typedef enum {
TupleState, ArrayState, RecordState, SimpleState
} StateType;
......@@ -193,15 +188,6 @@ STRUCT(ident,Ident){
char * ident_u1_instructions;
} 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;
unsigned char ident_table; /* TableKind */
unsigned char ident_mark;
......@@ -212,11 +198,6 @@ STRUCT(ident,Ident){
#define ident_tv ident_union1.ident_u1_tv
#define ident_uni_var ident_union1.ident_u1_uni_var
#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
#endif
#define IMPORT_MASK 1
#define IMPORTED_MASK 2
......@@ -426,7 +407,6 @@ STRUCT (node,Node){
struct if_node_contents * contents_if;
Symbol contents_symbol;
NodeId contents_node_id;
Ident contents_ident;
struct node * contents_node;
struct node_id_list_element *contents_node_ids;
#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
......@@ -480,7 +460,6 @@ STRUCT (node,Node){
#define node_node_defs node_su.su_u.u_node_defs
#define node_symbol node_contents.contents_symbol
#define node_node_id node_contents.contents_node_id
#define node_ident node_contents.contents_ident
#define node_node node_contents.contents_node
#define node_node_ids node_contents.contents_node_ids
......@@ -507,7 +486,7 @@ STRUCT (arg,Arg){
struct arg * arg_next;
union {
StateS u_state;
unsigned long u_occurrence; /* OccurrenceKind */
unsigned long u_occurrence;
} arg_u;
};
typedef struct arg *Args;
......@@ -516,39 +495,16 @@ typedef struct arg *Args;
#define arg_occurrence arg_u.u_occurrence
STRUCT (node_def,NodeDef){
union {
NodeId u1_id;
Node u1_pattern;
} def_u1;
NodeId def_id;
Node def_node;
NodeDefs def_next;
int def_mark;
};
#define def_id def_u1.u1_id
#define def_pattern def_u1.u1_pattern
#define NODE_DEF_HAS_LHS_PATTERN_MASK 1
#define NODE_DEF_NEW_SCOPE_MASK 2
#define NODE_DEF_NORMAL_SCOPE_MASK 4
#define NODE_DEF_MARKED 8
#define NODE_DEF_OBSERVE_MASK 16
#define NODE_DEF_SELECT_AND_REMOVE_MASK 32
typedef struct local_def {
union {
NodeId contents_node_id; /* ldef_node_id, if ldef_kind==0 */
Symbol contents_symbol; /* ldef_symbol, if ldef_kind==1 */
} ldef_contents;
struct local_def * ldef_next;
int ldef_scope;
char ldef_kind;
char ldef_lifted;
} LocalDef,*LocalDefP;
#define ldef_node_id ldef_contents.contents_node_id
#define ldef_symbol ldef_contents.contents_symbol
/* for implementing calls to C or the OS */
typedef struct parameter Parameter,*Parameters;
......@@ -600,11 +556,7 @@ STRUCT (rule_alt,RuleAlt){
StrictNodeIdP alt_strict_node_ids;
RuleAlts alt_next;
unsigned alt_line;
#ifdef OS2
unsigned alt_kind:4; /* RhsKind */
#else
unsigned alt_kind:3; /* RhsKind */
#endif
Bool alt_may_fail:1;
};
......@@ -614,16 +566,13 @@ STRUCT (rule_alt,RuleAlt){
typedef enum {
NEWDEFINITION, ABSTYPE, TYPE, TYPESYN, DEFRULE, IMPRULE,
CONSTRUCTOR, SYSRULE,
RECORDTYPE, FIELDSELECTOR,
INSTANCE
RECORDTYPE, FIELDSELECTOR
} SDefKind;
#define SDefKindSize 5
typedef enum {
Indefinite, CurrentlyChecked, TypeChecked,
Predefined, Expanded, TotallyExpanded,
ConvertingToState, ConvertedToState
TypeChecked, ConvertingToState, ConvertedToState
} CheckStatus;
typedef enum {
......@@ -659,7 +608,6 @@ STRUCT (imp_rule,ImpRule){
unsigned rule_ref_count;
};
#define RULE_CHECKED_MASK 1
#define RULE_CAF_MASK 2
#define RULE_LAZY_CALL_NODE_MASK 4
#if STORE_STRICT_CALL_NODES
......@@ -670,7 +618,6 @@ STRUCT (imp_rule,ImpRule){
#define RULE_UNBOXED_LAZY_CALL 64
#define RULE_INTERNAL_FUNCTION_MASK 128
#define RULE_LAMBDA_FUNCTION_MASK 256
#define RULE_HAS_REF_COUNT_MASK 512
#define RULE_CALL_VIA_LAZY_SELECTIONS_ONLY 1024
#define RULE_TAIL_MODULO_CONS_ENTRY_MASK 2048
......@@ -690,14 +637,9 @@ STRUCT (symbol_def,SymbDef){
ImpRules u_rule;
} sdef_u;
union
{ struct symbol_type_info * sti_rule_type_info;
struct symbol_typ