* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.14 $
- * $Date: 1999/11/29 18:59:34 $
+ * $Revision: 1.32 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
typedef Cell Ext; /* extension label */
#endif
+typedef Cell ConId;
+typedef Cell VarId;
+typedef Cell QualId;
+typedef Cell ConVarId;
+
/* --------------------------------------------------------------------------
* Text storage:
* provides storage for the characters making up identifier and symbol
* and string text etc.
* ------------------------------------------------------------------------*/
+#if !defined(SIZEOF_VOID_P) || !defined(SIZEOF_INT)
+#error SIZEOF_VOID_P or SIZEOF_INT is not defined
+#endif
+
#define TAGMIN 1 /* Box and constructor cell tag values */
#define BCSTAG 30 /* Box=TAGMIN..BCSTAG-1 */
#define isTag(c) (TAGMIN<=(c) && (c)<SPECMIN) /* Tag cell values */
#define ADDPAT 11 /* (_+k) pattern discr: snd :: Int */
#define FLOATCELL 15 /* Floating Pt literal: snd :: Text */
#define BIGCELL 16 /* Integer literal: snd :: Text */
-#if PTR_ON_HEAP
#define PTRCELL 17 /* C Heap Pointer snd :: Ptr */
+#define CPTRCELL 21 /* Native code pointer snd :: Ptr */
+
#if IPARAM
#define IPCELL 19 /* Imp Param Cell: snd :: Text */
#define IPVAR 20 /* ?x: snd :: Text */
#endif
-#define CPTRCELL 21 /* Native code pointer snd :: Ptr */
-#endif
+
#if TREX
#define EXTCOPY 22 /* Copy of an Ext: snd :: Text */
#endif
-//#define textOf(c) ((Text)(snd(c))) /* c :: (VAR|CON)(ID|OP) */
-
-#if 1
-static Text textOf( Cell c )
-{
- Bool ok =
- (whatIs(c)==VARIDCELL
- || whatIs(c)==CONIDCELL
- || whatIs(c)==VAROPCELL
- || whatIs(c)==CONOPCELL
- || whatIs(c)==STRCELL
- || whatIs(c)==DICTVAR
- );
- if (!ok) {
-fprintf(stderr, "\ntextOf -- tag %d\n",whatIs(c) );
- assert(ok);
- }
- return snd(c);
-}
-#endif
-
#define qmodOf(c) (textOf(fst(snd(c)))) /* c :: QUALIDENT */
#define qtextOf(c) (textOf(snd(snd(c)))) /* c :: QUALIDENT */
#define mkVar(t) ap(VARIDCELL,t)
#define mkQCon(m,t) ap(QUALIDENT,pair(mkCon(m),mkCon(t)))
#define mkQVarOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkVarop(t)))
#define mkQConOp(m,t) ap(QUALIDENT,pair(mkCon(m),mkConop(t)))
+#define mkQualId(m,t) ap(QUALIDENT,pair(m,t))
#define intValOf(c) (snd(c))
#define inventVar() mkVar(inventText())
#define mkDictVar(t) ap(DICTVAR,t)
#else
#define isIP(p) FALSE
#endif
-extern Bool isVar Args((Cell));
-extern Bool isCon Args((Cell));
-extern Bool isQVar Args((Cell));
-extern Bool isQCon Args((Cell));
-extern Bool isQualIdent Args((Cell));
-extern Bool isIdent Args((Cell));
-extern String stringNegate Args((String));
+extern Bool isVar Args((Cell));
+extern Bool isCon Args((Cell));
+extern Bool isQVar Args((Cell));
+extern Bool isQCon Args((Cell));
+extern Bool isQualIdent Args((Cell));
+extern Bool eqQualIdent ( QualId c1, QualId c2 );
+extern Bool isIdent Args((Cell));
+extern String stringNegate Args((String));
+extern Text textOf Args((Cell));
#define isFloat(c) (isPair(c) && fst(c)==FLOATCELL)
#define stringToFloat(s) pair(FLOATCELL,findText(s))
#define stringToBignum(s) pair(BIGCELL,findText(s))
#define bignumToString(b) textToStr(snd(b))
-
-#if PTR_ON_HEAP
#define isPtr(c) (isPair(c) && fst(c)==PTRCELL)
extern Cell mkPtr Args((Ptr));
extern Ptr ptrOf Args((Cell));
#define isCPtr(c) (isPair(c) && fst(c)==CPTRCELL)
extern Cell mkCPtr Args((Ptr));
extern Ptr cptrOf Args((Cell));
-#endif
/* --------------------------------------------------------------------------
* Constructor cell tags are used as the fst element of a pair to indicate
#define FATBAR 42 /* FATBAR snd :: (Exp,Exp) */
#define LAZYPAT 43 /* LAZYPAT snd :: Exp */
#define DERIVE 45 /* DERIVE snd :: Cell */
-#if BREAK_FLOATS
-#define FLOATCELL 46 /* FLOATCELL snd :: (Int,Int) */
-#endif
-
#define BOOLQUAL 49 /* BOOLQUAL snd :: Exp */
#define QWHERE 50 /* QWHERE snd :: [Decl] */
#define FROMQUAL 51 /* FROMQUAL snd :: (Exp,Exp) */
#define DOQUAL 52 /* DOQUAL snd :: Exp */
#define MONADCOMP 53 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/
-
#define GUARDED 54 /* GUARDED snd :: [guarded exprs] */
-
#define ARRAY 55 /* Array snd :: (Bounds,[Values]) */
#define MUTVAR 56 /* Mutvar snd :: Cell */
-#if INTERNAL_PRIMS
#define HUGSOBJECT 57 /* HUGSOBJECT snd :: Cell */
-#endif
#if IPARAM
#define WITHEXP 58 /* WITHEXP snd :: [(Var,Exp)] */
#endif
-
#define POLYTYPE 60 /* POLYTYPE snd :: (Kind,Type) */
#define QUAL 61 /* QUAL snd :: ([Classes],Type) */
#define RANK2 62 /* RANK2 snd :: (Int,Type) */
#define NEG 79 /* NEG snd :: Exp */
/* Used when parsing GHC interface files */
-#define DICTAP 80 /* DICTTYPE snd :: (QClassId,[Type]) */
+#define DICTAP 80 /* DICTAP snd :: (QClassId,[Type]) */
+#define UNBOXEDTUP 81 /* UNBOXEDTUP snd :: [Type] */
-#if SIZEOF_INTP != SIZEOF_INT
-#define PTRCELL 81 /* C Heap Pointer snd :: (Int,Int) */
+#if SIZEOF_VOID_P != SIZEOF_INT
+#define PTRCELL 82 /* C Heap Pointer snd :: (Int,Int) */
#endif
+/* STG syntax */
#define STGVAR 92 /* STGVAR snd :: (StgRhs,info) */
#define STGAPP 93 /* STGAPP snd :: (StgVar,[Arg]) */
#define STGPRIM 94 /* STGPRIM snd :: (PrimOp,[Arg]) */
#define DEEFALT 97 /* DEEFALT snd :: (Var,Expr) */
#define CASEALT 98 /* CASEALT snd :: (Con,[Var],Expr) */
#define PRIMALT 99 /* PRIMALT snd :: ([Var],Expr) */
+
+
+/*
+ Top-level interface entities
+ type Line = Int -- a line number
+ type ConVarId = CONIDCELL | VARIDCELL
+ type <a> = ZList a
+ type ExportListEntry = ConVarId | (ConId, <ConVarId>)
+ type Associativity = mkInt of LEFT_ASS | RIGHT_ASS | NON_ASS
+ type Constr = ((ConId, [((Type,VarId,Int))]))
+ ((constr name, [((type, field name if any, strictness))]))
+ strictness: 0 => none, 1 => !, 2 => !! (unpacked)
+ All 2/3/4/5 tuples in the interface abstract syntax are done with
+ z-tuples.
+*/
+
+#define I_INTERFACE 109 /* snd :: ((ConId, [I_IMPORT..I_VALUE]))
+ interface name, list of iface entities */
+
+#define I_IMPORT 110 /* snd :: ((ConId, [ConVarId]))
+ module name, list of entities */
+
+#define I_INSTIMPORT 111 /* snd :: NIL -- not used at present */
+
+#define I_EXPORT 112 /* snd :: ((ConId, [ExportListEntry]))
+ this module name?, entities to export */
+
+#define I_FIXDECL 113 /* snd :: ((NIL|Int, Associativity, ConVarId))
+ fixity, associativity, name */
+
+#define I_INSTANCE 114 /* snd :: ((Line,
+ [((VarId,Kind))],
+ Type, VarId, Inst))
+ lineno,
+ forall-y bit (eg __forall [a b] =>),
+ other bit, eg { C a1 } -> { C2 a2 } -> ... -> { Cn an },
+ name of dictionary builder,
+ (after startGHCInstance) the instance table location */
+
+#define I_TYPE 115 /* snd :: ((Line, ConId, [((VarId,Kind))], Type))
+ lineno, tycon, kinded tyvars, the type expr */
+
+#define I_DATA 116 /* snd :: ((Line, [((QConId,VarId))], ConId,
+ [((VarId,Kind))], [Constr])
+ lineno, context, tycon, kinded tyvars, constrs
+ An empty constr list means exported abstractly. */
+
+#define I_NEWTYPE 117 /* snd :: ((Line, [((QConId,VarId))], ConId,
+ [((VarId,Kind))], ((ConId,Type)) ))
+ lineno, context, tycon, kinded tyvars, constr
+ constr==NIL means exported abstractly. */
+
+#define I_CLASS 118 /* snd :: ((Line, [((QConId,VarId))], ConId,
+ [((VarId,Kind))], [((VarId,Type))]))
+ lineno, context, classname,
+ kinded tyvars, method sigs */
+
+#define I_VALUE 119 /* snd :: ((Line, VarId, Type)) */
+
+
+
+/* Generic syntax */
+#if 0
+#define ZCONS 190 /* snd :: (Cell,Cell) */
+#endif
+
+
+#define ZTUP2 192 /* snd :: (Cell,Cell) */
+#define ZTUP3 193 /* snd :: (Cell,(Cell,Cell)) */
+#define ZTUP4 194 /* snd :: (Cell,(Cell,(Cell,Cell))) */
+#define ZTUP5 195 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */
+
/* Last constructor tag must be less than SPECMIN */
/* --------------------------------------------------------------------------
* Special cell values:
* ------------------------------------------------------------------------*/
-#define SPECMIN 101
-#define isSpec(c) (SPECMIN<=(c) && (c)<TUPMIN)/* Special cell values */
+#define SPECMIN 201
+
+#if TREX
+#define isSpec(c) (SPECMIN<=(c) && (c)<EXTMIN)/* Special cell values */
+#else
+#define isSpec(c) (SPECMIN<=(c) && (c)<OFFMIN)
+#endif
-#define NONE 101 /* Dummy stub */
-#define STAR 102 /* Representing the kind of types */
+#define NONE 201 /* Dummy stub */
+#define STAR 202 /* Representing the kind of types */
#if TREX
-#define ROW 103 /* Representing the kind of rows */
+#define ROW 203 /* Representing the kind of rows */
#endif
-#define WILDCARD 104 /* Wildcard pattern */
-#define SKOLEM 105 /* Skolem constant */
-
-#define DOTDOT 106 /* ".." in import/export list */
-
-#define NAME 110 /* whatIs code for isName */
-#define TYCON 111 /* whatIs code for isTycon */
-#define CLASS 112 /* whatIs code for isClass */
-#define MODULE 113 /* whatIs code for isModule */
-#define INSTANCE 114 /* whatIs code for isInst */
-#define TUPLE 115 /* whatIs code for tuple constructor */
-#define OFFSET 116 /* whatis code for offset */
-#define AP 117 /* whatIs code for application node */
-#define CHARCELL 118 /* whatIs code for isChar */
+#define WILDCARD 204 /* Wildcard pattern */
+#define SKOLEM 205 /* Skolem constant */
+
+#define DOTDOT 206 /* ".." in import/export list */
+
+#define NAME 210 /* whatIs code for isName */
+#define TYCON 211 /* whatIs code for isTycon */
+#define CLASS 212 /* whatIs code for isClass */
+#define MODULE 213 /* whatIs code for isModule */
+#define INSTANCE 214 /* whatIs code for isInst */
+#define TUPLE 215 /* whatIs code for tuple constructor */
+#define OFFSET 216 /* whatis code for offset */
+#define AP 217 /* whatIs code for application node */
+#define CHARCELL 218 /* whatIs code for isChar */
#if TREX
-#define EXT 119 /* whatIs code for isExt */
+#define EXT 219 /* whatIs code for isExt */
#endif
-#define SIGDECL 120 /* Signature declaration */
-#define FIXDECL 121 /* Fixity declaration */
-#define FUNBIND 122 /* Function binding */
-#define PATBIND 123 /* Pattern binding */
+#define SIGDECL 220 /* Signature declaration */
+#define FIXDECL 221 /* Fixity declaration */
+#define FUNBIND 222 /* Function binding */
+#define PATBIND 223 /* Pattern binding */
-#define DATATYPE 130 /* Datatype type constructor */
-#define NEWTYPE 131 /* Newtype type constructor */
-#define SYNONYM 132 /* Synonym type constructor */
-#define RESTRICTSYN 133 /* Synonym with restricted scope */
+#define DATATYPE 230 /* Datatype type constructor */
+#define NEWTYPE 231 /* Newtype type constructor */
+#define SYNONYM 232 /* Synonym type constructor */
+#define RESTRICTSYN 233 /* Synonym with restricted scope */
-#define NODEPENDS 135 /* Stop calculation of deps in type check*/
-#define PREDEFINED 136 /* Predefined name, not yet filled */
+#define NODEPENDS 235 /* Stop calculation of deps in type check*/
+#define PREDEFINED 236 /* Predefined name, not yet filled */
/* --------------------------------------------------------------------------
* Tuple data/type constructors:
* ------------------------------------------------------------------------*/
-#define TUPMIN 201
-#if TREX
-#define isTuple(c) (TUPMIN<=(c) && (c)<EXTMIN)
-#else
-#define isTuple(c) (TUPMIN<=(c) && (c)<OFFMIN)
-#endif
-#define mkTuple(n) (TUPMIN+(n))
-#define tupleOf(n) ((Int)((n)-TUPMIN))
-extern Text ghcTupleText Args((Tycon));
+extern Text ghcTupleText Args((Tycon));
+extern Text ghcTupleText_n Args((Int));
#if TREX
-#define EXTMIN (TUPMIN+NUM_TUPLES)
+#define EXTMIN 301
#define isExt(c) (EXTMIN<=(c) && (c)<OFFMIN)
#define extText(e) tabExt[(e)-EXTMIN]
#define extField(c) arg(fun(c))
#define mkExt(t) NIL
#endif
+extern Module findFakeModule ( Text t );
+extern Tycon addTupleTycon ( Int n );
+extern Name addWiredInBoxingTycon
+ ( String modNm, String typeNm, String constrNm,
+ Int rep, Kind kind );
+Tycon addWiredInEnumTycon ( String modNm, String typeNm,
+ List /*of Text*/ constrs );
+
/* --------------------------------------------------------------------------
* Offsets: (generic types/stack offsets)
* ------------------------------------------------------------------------*/
#if TREX
#define OFFMIN (EXTMIN+NUM_EXT)
#else
-#define OFFMIN (TUPMIN+NUM_TUPLES)
+#define OFFMIN 301
#endif
#define isOffset(c) (OFFMIN<=(c) && (c)<MODMIN)
#define offsetOf(c) ((c)-OFFMIN)
#define mkOffset(o) (OFFMIN+(o))
-/* --------------------------------------------------------------------------
- * Object symbols:
- * ------------------------------------------------------------------------*/
-
-/* An entry in a very crude object symbol table */
-typedef struct { char* nm; void* ad; }
- OSym;
-
-/* Indication of section kinds for loaded objects. Needed by
- the GC for deciding whether or not a pointer on the stack
- is a code pointer.
-*/
-typedef enum { HUGS_DL_SECTION_CODE_OR_RODATA,
- HUGS_DL_SECTION_RWDATA,
- HUGS_DL_SECTION_OTHER }
- DLSect;
-
-typedef struct { void* start; void* end; DLSect sect; }
- DLTabEnt;
/* --------------------------------------------------------------------------
* Modules:
#define mkModule(n) (MODMIN+(n))
#define module(n) tabModule[(n)-MODMIN]
+/* Import defns for the ObjectCode struct in Module. */
+#include "object.h"
+
/* Under Haskell 1.3, the list of qualified imports is always a subset
* of the list of unqualified imports. For simplicity and flexibility,
* we do not attempt to exploit this fact - when a module is imported
*/
List qualImports;
- /* ptr to malloc'd lump of memory holding the obj file */
- void* oImage;
+ /* TRUE if module exists only via GHC primop defn; usually FALSE */
+ Bool fake;
- /* ptr to object symbol table; lives in mallocville.
- Dynamically expands. */
- OSym* oTab;
- Int sizeoTab;
- Int usedoTab;
+ /* The primary object file for this module. */
+ ObjectCode* object;
- /* The section-kind entries for this object module. Dynamically expands. */
- DLTabEnt* dlTab;
- Int sizedlTab;
- Int useddlTab;
+ /* And any extras it might need. */
+ ObjectCode* objectExtras;
+ List objectExtraNames; /* :: [Text] -- names of extras */
};
+
extern Module currentModule; /* Module currently being processed */
extern struct Module DECTABLE(tabModule);
extern void* lookupOTabName Args((Module,char*));
extern char* nameFromOPtr Args((void*));
-extern void addDLSect Args((Module,void*,void*,DLSect));
-extern DLSect lookupDLSect Args((void*));
-
+extern void addSection Args((Module,void*,void*,OSectionKind));
+extern OSectionKind lookupSection Args((void*));
+extern void* lookupOExtraTabName ( char* sym );
#define isPrelude(m) (m==modulePrelude)
+#define N_PRELUDE_SCRIPTS (combined ? 32 : 1)
+
/* --------------------------------------------------------------------------
* Type constructor names:
* ------------------------------------------------------------------------*/
#define TYCMIN (MODMIN+NUM_MODULE)
-#define isTycon(c) (TYCMIN<=(c) && (c)<NAMEMIN)
-#define mkTycon(n) (TCMIN+(n))
+#define isTycon(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple==-1)
#define tycon(n) tabTycon[(n)-TYCMIN]
+#define isTuple(c) (TYCMIN<=(c) && (c)<NAMEMIN && tabTycon[(c)-TYCMIN].tuple>=0)
+#define tupleOf(n) (tabTycon[(n)-TYCMIN].tuple)
+extern Tycon mkTuple ( Int );
+
+
struct strTycon {
Text text;
Int line;
Module mod; /* module that defines it */
+ Int tuple; /* tuple number, or -1 if not tuple */
Int arity;
Kind kind; /* kind (includes arity) of Tycon */
Cell what; /* DATATYPE/SYNONYM/RESTRICTSYN... */
Cell defn;
Name conToTag; /* used in derived code */
Name tagToCon;
+ void* itbl; /* For tuples, the info tbl pointer */
Tycon nextTyconHash;
};
#define polySigOf(t) fst(snd(t))
#define monotypeOf(t) snd(snd(t))
+#define bang(t) ap(BANG,t)
+extern Tycon findQualTyconWithoutConsultingExportList ( QualId q );
+
/* --------------------------------------------------------------------------
* Globally defined name values:
* ------------------------------------------------------------------------*/
Int number;
Cell type;
Cell defn;
- Cell stgVar; /* really StgVar */
- Text callconv; /* for foreign import/export */
- void* primop; /* really StgPrim* */
+ Cell stgVar; /* really StgVar */
+ Text callconv; /* for foreign import/export */
+ void* primop; /* really StgPrim* */
+ void* itbl; /* For constructors, the info tbl pointer */
Name nextNameHash;
};
extern Name nameFromStgVar Args((Cell));
extern Name jrsFindQualName Args((Text,Text));
+extern Name findQualNameWithoutConsultingExportList ( QualId q );
+
/* --------------------------------------------------------------------------
* Type class values:
* ------------------------------------------------------------------------*/
extern Inst newInst Args((Void));
extern Inst findFirstInst Args((Tycon));
extern Inst findNextInst Args((Tycon,Inst));
+extern List getAllKnownTyconsAndClasses ( void );
+extern Class findQualClassWithoutConsultingExportList ( QualId q );
/* --------------------------------------------------------------------------
* Character values:
extern Bool eqList Args((List,List));
extern Cell varIsMember Args((Text,List));
extern Name nameIsMember Args((Text,List));
+extern QualId qualidIsMember ( QualId, List );
extern Cell intIsMember Args((Int,List));
extern List replicate Args((Int,Cell));
extern List diffList Args((List,List)); /* destructive */
#define map2Accum(_f,_acc,_a,_b,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,hd(Zs)))
#define map3Accum(_f,_acc,_a,_b,_c,_xs) mapBasic(_xs,_acc=_f(_acc,_a,_b,_c,hd(Zs)))
+
+/* --------------------------------------------------------------------------
+ * Strongly-typed lists (z-lists) and tuples (experimental)
+ * ------------------------------------------------------------------------*/
+
+typedef Cell ZPair;
+typedef Cell ZTriple;
+typedef Cell Z4Ble;
+typedef Cell Z5Ble;
+
+#if 0
+typedef Cell ZList;
+extern Cell zcons ( Cell x, Cell xs );
+extern Cell zhd ( Cell xs );
+extern Cell ztl ( Cell xs );
+extern Cell zsingleton ( Cell x );
+extern Cell zdoubleton ( Cell x, Cell y );
+extern Int zlength ( ZList xs );
+extern ZList zreverse ( ZList xs );
+#endif
+
+extern Cell zpair ( Cell x1, Cell x2 );
+extern Cell zfst ( Cell zpair );
+extern Cell zsnd ( Cell zpair );
+
+extern Cell ztriple ( Cell x1, Cell x2, Cell x3 );
+extern Cell zfst3 ( Cell zpair );
+extern Cell zsnd3 ( Cell zpair );
+extern Cell zthd3 ( Cell zpair );
+
+extern Cell z4ble ( Cell x1, Cell x2, Cell x3, Cell x4 );
+extern Cell zsel14 ( Cell zpair );
+extern Cell zsel24 ( Cell zpair );
+extern Cell zsel34 ( Cell zpair );
+extern Cell zsel44 ( Cell zpair );
+
+extern Cell z5ble ( Cell x1, Cell x2, Cell x3, Cell x4, Cell x5 );
+extern Cell zsel15 ( Cell zpair );
+extern Cell zsel25 ( Cell zpair );
+extern Cell zsel35 ( Cell zpair );
+extern Cell zsel45 ( Cell zpair );
+extern Cell zsel55 ( Cell zpair );
+
+extern Cell unap ( int tag, Cell c );
+#define isZPair(c) (whatIs((c))==ZTUP2)
+
/* --------------------------------------------------------------------------
* Implementation of function application nodes:
* ------------------------------------------------------------------------*/
extern List addTyconsMatching Args((String,List));
extern List addNamesMatching Args((String,List));
+extern Tycon findTyconInAnyModule ( Text t );
+extern Class findClassInAnyModule ( Text t );
+extern Name findNameInAnyModule ( Text t );
+extern Void print Args((Cell, Int));
+extern void dumpTycon ( Int t );
+extern void dumpName ( Int n );
+extern void dumpClass ( Int c );
+extern void dumpInst ( Int i );
+extern void locateSymbolByName ( Text t );
+
+#if LEADING_UNDERSCORE
+#define MAYBE_LEADING_UNDERSCORE(sss) _##sss
+#define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
+#else
+#define MAYBE_LEADING_UNDERSCORE(sss) sss
+#define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
+#endif
+
/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff