+
/* --------------------------------------------------------------------------
* Connections between components of the Hugs system
*
* included in the distribution.
*
* $RCSfile: connect.h,v $
- * $Revision: 1.15 $
- * $Date: 1999/11/12 17:32:38 $
+ * $Revision: 1.41 $
+ * $Date: 2000/05/10 09:00:20 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
- * Standard data:
+ * Connections to Prelude entities:
+ * Texts, Names, Instances, Classes, Types, Kinds and Modules
* ------------------------------------------------------------------------*/
-extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
-extern Module modulePrelude;
+extern Text textPrelPrim;
+extern Text textPrelude;
+extern Text textNum; /* used to process default decls */
+extern Text textCcall; /* used to process foreign import */
+extern Text textStdcall; /* ... and foreign export */
+extern Text textPlus; /* Used to recognise n+k patterns */
-/* --------------------------------------------------------------------------
- * Primitive constructor functions
- * ------------------------------------------------------------------------*/
extern Name nameFalse, nameTrue;
extern Name nameNil, nameCons;
extern Name nameJust, nameNothing;
extern Name nameLeft, nameRight;
extern Name nameUnit;
-
extern Name nameLT, nameEQ;
extern Name nameGT;
extern Name nameFst, nameSnd; /* standard combinators */
extern Name nameCompAux;
extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
extern Name namePmInteger;
-#if NPLUSK
extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */
-#endif
extern Name nameError; /* For runtime error messages */
extern Name nameUndefined; /* A generic undefined value */
extern Name nameBlackHole; /* For GC-detected black hole */
extern Name nameLe, nameGt;
extern Name nameShowsPrec, nameReadsPrec;
extern Name nameMult, namePlus;
-extern Name nameConCmp, nameEnRange;
-extern Name nameEnIndex, nameEnInRng;
-extern Name nameEnToEn, nameEnFrEn;
-extern Name nameEnFrom, nameEnFrTh;
-extern Name nameEnFrTo;
extern Name nameComp, nameApp; /* composition and append */
extern Name nameShowField; /* display single field */
extern Name nameShowParen; /* wrap with parens */
extern Name nameReadParen; /* unwrap from parens */
extern Name nameLex; /* lexer */
extern Name nameRangeSize; /* calculate size of index range */
-extern Class classMonad; /* Monads */
extern Name nameReturn, nameBind; /* for translating monad comps */
extern Name nameMFail;
extern Name nameListMonad; /* builder function for List Monad */
extern Name namePrint; /* printing primitive */
extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */
-extern Text textPrelude;
-extern Text textNum; /* used to process default decls */
-extern Text textCcall; /* used to process foreign import */
-extern Text textStdcall; /* ... and foreign export */
+extern Name nameShow;
+extern Name namePutStr;
+extern Name nameRunIO_toplevel;
+
+/* The following data constructors are used to make boxed but
+ * unpointed values pointed and require no special treatment
+ * by the code generator. */
+extern Name nameMkInteger;
+extern Name nameMkPrimArray;
+extern Name nameMkPrimByteArray;
+extern Name nameMkRef;
+extern Name nameMkPrimMutableArray;
+extern Name nameMkPrimMutableByteArray;
+extern Name nameMkThreadId;
+extern Name nameMkPrimMVar;
+#ifdef PROVIDE_FOREIGN
+extern Name nameMkForeign;
+#endif
+#ifdef PROVIDE_WEAK
+extern Name nameMkWeak;
+#endif
-#if NPLUSK
-extern Text textPlus; /* Used to recognise n+k patterns */
+/* The following data constructors are used to box unboxed
+ * arguments and are treated differently by the code generator.
+ * That is, they have primop `elem` {INT_REP,FLOAT_REP,...}. */
+#define boxingConRep(con) ((AsmRep)(name(con).primop))
+#define isBoxingCon(con) (isName(con) && boxingConRep(con) != 0)
+extern Name nameMkC;
+extern Name nameMkI;
+extern Name nameMkW;
+extern Name nameMkA;
+extern Name nameMkF;
+extern Name nameMkD;
+extern Name nameMkStable;
+
+/* used while desugaring */
+extern Name nameId;
+extern Name nameOtherwise;
+extern Name nameUndefined; /* generic undefined value */
+
+/* used in pattern match */
+extern Name namePmSub;
+extern Name nameSel;
+
+/* used in translation */
+extern Name nameEq;
+extern Name namePMFail;
+extern Name nameEqChar;
+extern Name nameEqInteger;
+extern Name namePmInt;
+extern Name namePmInteger;
+extern Name namePmDouble;
+extern Name namePmLe;
+extern Name namePmSubtract;
+extern Name namePmFromInteger;
+extern Name nameMkIO;
+extern Name nameUnpackString;
+extern Name namePrimSeq;
+extern Name nameMap;
+extern Name nameMinus;
+
+/* assertion and exceptions */
+extern Name nameAssert;
+extern Name nameAssertError;
+extern Name nameTangleMessage;
+extern Name nameIrrefutPatError;
+extern Name nameNoMethodBindingError;
+extern Name nameNonExhaustiveGuardsError;
+extern Name namePatError;
+extern Name nameRecSelError;
+extern Name nameRecConError;
+extern Name nameRecUpdError;
+
+
+extern Class classMonad; /* Monads */
+extern Class classEq; /* `standard' classes */
+extern Class classOrd;
+extern Class classShow;
+extern Class classRead;
+extern Class classIx;
+extern Class classEnum;
+extern Class classBounded;
+extern Class classReal; /* `numeric' classes */
+extern Class classIntegral;
+extern Class classRealFrac;
+extern Class classRealFloat;
+extern Class classFractional;
+extern Class classFloating;
+extern Class classNum;
+
+
+extern Type typeProgIO; /* For the IO monad, IO a */
+extern Type typeArrow; /* Builtin type constructors */
+extern Type typeList;
+extern Type typeUnit;
+extern Type typeInt64;
+extern Type typeWord;
+extern Type typeFloat;
+extern Type typePrimArray;
+extern Type typePrimByteArray;
+extern Type typeRef;
+extern Type typePrimMutableArray;
+extern Type typePrimMutableByteArray;
+extern Type typeStable;
+extern Type typeWeak;
+extern Type typeIO;
+extern Type typeForeign;
+extern Type typeMVar;
+extern Type typeThreadId;
+extern Type typeException;
+extern Type typeIO;
+extern Type typeST;
+extern Type typeOrdering;
+extern List stdDefaults; /* List of standard default types */
+
+/* For every primitive type provided by the runtime system,
+ * we construct a Haskell type using a declaration of the form:
+ *
+ * data Int -- no constructors given
+ */
+extern Type typeChar;
+extern Type typeInt;
+extern Type typeInteger;
+extern Type typeWord;
+extern Type typeAddr;
+extern Type typePrimArray;
+extern Type typePrimByteArray;
+extern Type typeRef;
+extern Type typePrimMutableArray;
+extern Type typePrimMutableByteArray;
+extern Type typeFloat;
+extern Type typeDouble;
+extern Type typeStable;
+extern Type typeThreadId;
+extern Type typeMVar;
+#ifdef PROVIDE_WEAK
+extern Type typeWeak;
#endif
+#ifdef PROVIDE_FOREIGN
+extern Type typeForeign;
+#endif
+
+/* And a smaller number of types defined in plain Haskell */
+extern Type typeList;
+extern Type typeUnit;
+extern Type typeString;
+extern Type typeBool;
+extern Type typeST;
+extern Type typeIO;
+extern Type typeException;
+
+extern Module modulePrelPrim;
+extern Module modulePrelude;
+
+extern Kind starToStar; /* Type -> Type */
+
+
#if TREX
-extern Name nameNoRec; /* The empty record */
-extern Type typeNoRow; /* The empty row */
-extern Type typeRec; /* Record formation */
-extern Kind extKind; /* Kind of extension, *->row->row */
extern Name nameRecExt; /* Extend a record */
extern Name nameRecBrk; /* Break a record */
extern Name nameAddEv; /* Addition of evidence values */
extern Name nameRecEq; /* Compare records */
extern Name nameEqRecRow; /* Used to compare rows */
extern Name nameInsFld; /* Field insertion routine */
+extern Name nameNoRec; /* The empty record */
+extern Type typeNoRow; /* The empty row */
+extern Type typeRec; /* Record formation */
+extern Kind extKind; /* Kind of extension, *->row->row */
#endif
-extern String repeatStr; /* Repeat last command string */
-extern String hugsEdit; /* String for editor command */
-extern String hugsPath; /* String for file search path */
-extern String projectPath; /* String for project search path */
-extern Type typeArrow; /* Builtin type constructors */
-extern Type typeList;
-extern Type typeUnit;
+/* --------------------------------------------------------------------------
+ * Constructions from the above names, types, etc.
+ * ------------------------------------------------------------------------*/
+
+
+extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
+extern Type listof; /* [ mkOffset(0) ] */
+extern Cell predNum; /* Num (mkOffset(0)) */
+extern Cell predFractional; /* Fractional (mkOffset(0)) */
+extern Cell predIntegral; /* Integral (mkOffset(0)) */
+extern Cell predMonad; /* Monad (mkOffset(0)) */
+
+extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
+extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
+extern Type listof; /* [ mkOffset(0) ] */
+extern Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
+
+extern Cell predNum; /* Num (mkOffset(0)) */
+extern Cell predFractional; /* Fractional (mkOffset(0)) */
+extern Cell predIntegral; /* Integral (mkOffset(0)) */
+extern Kind starToStar; /* Type -> Type */
+extern Cell predMonad; /* Monad (mkOffset(0)) */
#define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */
-extern List stdDefaults; /* List of standard default types */
+#define aVar mkOffset(0) /* Simple skeleton for type var */
+extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
-extern Class classEq; /* `standard' classes */
-extern Class classOrd;
-extern Class classShow;
-extern Class classRead;
-extern Class classIx;
-extern Class classEnum;
-extern Class classBounded;
+#define consChar(c) ap(nameCons,mkChar(c))
-extern Class classReal; /* `numeric' classes */
-extern Class classIntegral;
-extern Class classRealFrac;
-extern Class classRealFloat;
-extern Class classFractional;
-extern Class classFloating;
-extern Class classNum;
+/* --------------------------------------------------------------------------
+ * Umm ....
+ * ------------------------------------------------------------------------*/
+
+extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
+extern Bool combined; /* TRUE => combined operation */
+extern Bool debugSC; /* TRUE => print SC to screen */
+extern Bool kindExpert; /* TRUE => display kind errors in */
+ /* full detail */
+extern Bool allowOverlap; /* TRUE => allow overlapping insts */
+
+extern String repeatStr; /* Repeat last command string */
+extern String hugsEdit; /* String for editor command */
+extern String hugsPath; /* String for file search path */
+extern String projectPath; /* String for project search path */
+
+extern Cell* CStackBase; /* pointer to base of C stack */
+
+extern List tyconDefns; /* list of type constructor defns */
+extern List typeInDefns; /* list of synonym restrictions */
+extern List valDefns; /* list of value definitions */
+extern List classDefns; /* list of class definitions */
+extern List instDefns; /* list of instance definitions */
+extern List selDefns; /* list of selector lists */
+extern List genDefns; /* list of generated defns */
+extern List primDefns; /* list of primitive definitions */
+extern List unqualImports; /* unqualified import list */
+extern List defaultDefns; /* default definitions (if any) */
+extern Int defaultLine; /* line in which default defs occur*/
+extern List evalDefaults; /* defaults for evaluator */
+extern Cell inputExpr; /* evaluator input expression */
+extern Cell inputContext; /* evaluator input expression */
+
+extern Cell whnfHead; /* head of term in whnf */
+extern Int whnfInt; /* integer value of term in whnf */
+extern Float whnfFloat; /* float value of term in whnf */
+extern Long numCells; /* number of cells allocated */
+extern Int numGcs; /* number of garbage collections */
+extern int numEnters; /* number of enters */
+extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
+extern Bool flagAssert; /* TRUE => assert False <e> causes
+ an assertion failure */
+
+extern Bool gcMessages; /* TRUE => print GC messages */
+extern Bool literateScripts; /* TRUE => default lit scripts */
+extern Bool literateErrors; /* TRUE => report errs in lit scrs */
+extern Bool showInstRes; /*TRUE => show instance resolution */
+
+extern Int cutoff; /* Constraint Cutoff depth */
+
+extern List diVars; /* deriving: cache of names */
+extern Int diNum; /* also for deriving */
+extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
+
+extern Module moduleBeingParsed; /* so the parser (topModule) knows */
-extern Cell *CStackBase; /* pointer to base of C stack */
-
-extern List tyconDefns; /* list of type constructor defns */
-extern List typeInDefns; /* list of synonym restrictions */
-extern List valDefns; /* list of value definitions */
-extern List classDefns; /* list of class definitions */
-extern List instDefns; /* list of instance definitions */
-extern List selDefns; /* list of selector lists */
-extern List genDefns; /* list of generated defns */
-extern List primDefns; /* list of primitive definitions */
-extern List unqualImports; /* unqualified import list */
-extern List defaultDefns; /* default definitions (if any) */
-extern Int defaultLine; /* line in which default defs occur*/
-extern List evalDefaults; /* defaults for evaluator */
-extern Cell inputExpr; /* evaluator input expression */
-extern Cell inputContext; /* evaluator input expression */
-extern Addr inputCode; /* Code for compiled input expr */
-
-extern Int whnfArgs; /* number of args of term in whnf */
-extern Cell whnfHead; /* head of term in whnf */
-extern Int whnfInt; /* integer value of term in whnf */
-extern Float whnfFloat; /* float value of term in whnf */
-extern Long numCells; /* number of cells allocated */
-extern Int numGcs; /* number of garbage collections */
-extern Bool broken; /* indicates interrupt received */
-extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
-
-extern Bool gcMessages; /* TRUE => print GC messages */
-extern Bool literateScripts; /* TRUE => default lit scripts */
-extern Bool literateErrors; /* TRUE => report errs in lit scrs */
-extern Bool showInstRes; /* TRUE => show instance resolution */
-
-extern Int cutoff; /* Constraint Cutoff depth */
#if USE_PREPROCESSOR
extern String preprocessor; /* preprocessor command */
#endif
-#if DEBUG_CODE
-extern Bool debugCode; /* TRUE => print G-code to screen */
-#endif
-#if DEBUG_SHOWSC
-extern Bool debugSC; /* TRUE => print SC to screen */
-extern Void printSc Args((FILE*, Text, Int, Cell));
-#endif
-extern Bool kindExpert; /* TRUE => display kind errors in */
- /* full detail */
-extern Bool allowOverlap; /* TRUE => allow overlapping insts */
/* --------------------------------------------------------------------------
* Function prototypes etc...
* ------------------------------------------------------------------------*/
-extern Void everybody Args((Int));
-#define RESET 1 /* reset subsystem */
-#define MARK 2 /* mark parts of graph in use by subsystem */
-#define INSTALL 3 /* install subsystem (executed once only) */
-#define EXIT 4 /* Take action immediately before exit() */
-#define BREAK 5 /* Take action after program break */
-#define GCDONE 6 /* Restore subsystem invariantss after GC */
+
+#define RESET 1 /* reset subsystem */
+#define MARK 2 /* mark parts of graph in use by subsystem */
+#define PREPREL 3 /* do startup actions before Prelude loading */
+#define POSTPREL 4 /* do startup actions after Prelude loading */
+#define EXIT 5 /* Take action immediately before exit() */
+#define BREAK 6 /* Take action after program break */
+#define GCDONE 7 /* Restore subsystem invariants after GC */
+
+/* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
+ in the old Hugs.
+*/
+extern Void everybody ( Int );
+extern Void linkControl ( Int );
+extern Void deriveControl ( Int );
+extern Void translateControl ( Int );
+extern Void codegen ( Int );
+extern Void machdep ( Int );
+extern Void liftControl ( Int );
+extern Void substitution ( Int );
+extern Void typeChecker ( Int );
+extern Void interface ( Int );
+extern Void storage ( Int );
+
+
typedef long Target;
-extern Void setGoal Args((String, Target));
-extern Void soFar Args((Target));
-extern Void done Args((Void));
-extern String fromEnv Args((String,String));
-extern Bool chase Args((List));
-
-extern Void storage Args((Int));
-
-extern Void input Args((Int));
-extern Void consoleInput Args((String));
-extern Void projInput Args((String));
-extern Void stringInput Args((String));
-extern Void parseScript Args((String,Long));
-extern Void parseExp Args((Void));
-extern Void parseContext Args((Void));
-extern String readFilename Args((Void));
-extern String readLine Args((Void));
-extern Syntax defaultSyntax Args((Text));
-extern Syntax syntaxOf Args((Name));
-extern String unlexChar Args((Char,Char));
-extern Void printString Args((String));
-
-extern Void substitution Args((Int));
-extern Void optimiser Args((Int));
-
-extern Void staticAnalysis Args((Int));
-extern Void startModule Args((Cell));
-extern Void setExportList Args((List));
-extern Void setExports Args((List));
-extern Void addQualImport Args((Text,Text));
-extern Void addUnqualImport Args((Text,List));
-
-extern Void tyconDefn Args((Int,Cell,Cell,Cell));
-extern Void setTypeIns Args((List));
-extern Void clearTypeIns Args((Void));
-extern Type fullExpand Args((Type));
-extern Bool isAmbiguous Args((Type));
-extern Void ambigError Args((Int,String,Cell,Type));
-extern Void classDefn Args((Int,Cell,List,List));
-extern Void instDefn Args((Int,Cell,Cell));
-extern Void addTupInst Args((Class,Int));
-#if TREX
-extern Inst addRecShowInst Args((Class,Ext));
-extern Inst addRecEqInst Args((Class,Ext));
+extern Void setGoal ( String, Target );
+extern Void soFar ( Target );
+extern Void done ( Void );
+extern String fromEnv ( String,String );
+extern Bool chase ( List );
+
+extern Void input ( Int );
+extern Void consoleInput ( String );
+extern Void projInput ( String );
+extern Void stringInput ( String );
+extern Cell parseModule ( String,Long );
+extern Void parseExp ( Void );
+#if EXPLAIN_INSTANCE_RESOLUTION
+extern Void parseContext ( Void );
#endif
-extern List typeVarsIn Args((Cell,List,List,List));
-extern List oclose Args((List,List));
-extern List zonkTyvarsIn Args((Type,List));
-extern Type zonkTyvar Args((Int));
-extern Type zonkType Args((Type,Int));
-extern Void primDefn Args((Cell,List,Cell));
-extern Void defaultDefn Args((Int,List));
-extern Void checkExp Args((Void));
-extern Void checkDefns Args((Void));
-extern Bool h98Pred Args((Bool,Cell));
-extern Cell h98Context Args((Bool,List));
-extern Void h98CheckCtxt Args((Int,String,Bool,List,Inst));
-extern Void h98CheckType Args((Int,String,Cell,Type));
-extern Void h98DoesntSupport Args((Int,String));
-
-extern Void typeChecker Args((Int));
-extern Type typeCheckExp Args((Bool));
-extern Void typeCheckDefns Args((Void));
-extern Cell provePred Args((Kinds,List,Cell));
-extern List simpleContext Args((List,Int));
-extern Cell rhsExpr Args((Cell));
-extern Int rhsLine Args((Cell));
-extern Bool isProgType Args((List,Type));
-extern Cell superEvid Args((Cell,Class,Class));
-extern Void linkPreludeTC Args((Void));
-extern Void linkPreludeCM Args((Void));
-
-extern Void compiler Args((Int));
-extern Void compileDefns Args((Void));
-extern Void compileExp Args((Void));
-extern Bool failFree Args((Cell));
-extern Int discrArity Args((Cell));
-
-extern Addr codeGen Args((Name,Int,Cell));
-extern Void implementCfun Args((Name,List));
+extern String readFilename ( Void );
+extern String readLine ( Void );
+extern Syntax defaultSyntax ( Text );
+extern Syntax syntaxOf ( Name );
+extern String unlexChar ( Char,Char );
+extern Void printString ( String );
+
+
+extern Void staticAnalysis ( Int );
+extern Void startModule ( Module );
+extern Void setExportList ( List );
+extern Void setExports ( List );
+extern Void addQualImport ( Text,Text );
+extern Void addUnqualImport ( Text,List );
+
+extern Void tyconDefn ( Int,Cell,Cell,Cell );
+extern Void setTypeIns ( List );
+extern Void clearTypeIns ( Void );
+extern Type fullExpand ( Type );
+extern Bool isAmbiguous ( Type );
+extern Void ambigError ( Int,String,Cell,Type );
+extern Void classDefn ( Int,Cell,List,List );
+extern Void instDefn ( Int,Cell,Cell );
+extern Void addTupInst ( Class,Int );
+extern Name newDSel ( Class,Int );
#if TREX
-extern Name implementRecShw Args((Text,Cell));
-extern Name implementRecEq Args((Text,Cell));
+extern Inst addRecShowInst ( Class,Ext );
+extern Inst addRecEqInst ( Class,Ext );
+#endif
+extern List offsetTyvarsIn ( Type,List );
+
+
+extern List typeVarsIn ( Cell,List,List,List );
+extern List oclose ( List,List );
+extern List zonkTyvarsIn ( Type,List );
+extern Type zonkTyvar ( Int );
+extern Type zonkType ( Type,Int );
+extern Void primDefn ( Cell,List,Cell );
+extern Void defaultDefn ( Int,List );
+extern Void checkExp ( Void );
+extern Type conToTagType ( Tycon );
+extern Type tagToConType ( Tycon );
+extern Int visitClass ( Class );
+
+#if EXPLAIN_INSTANCE_RESOLUTION
+extern Void checkContext ( Void );
+#endif
+extern Void checkDefns ( Module );
+extern Bool h98Pred ( Bool,Cell );
+extern Cell h98Context ( Bool,List );
+extern Void h98CheckCtxt ( Int,String,Bool,List,Inst );
+extern Void h98CheckType ( Int,String,Cell,Type );
+extern Void h98DoesntSupport ( Int,String );
+
+extern Int userArity ( Name );
+extern List deriveEq ( Tycon );
+extern List deriveOrd ( Tycon );
+extern List deriveEnum ( Tycon );
+extern List deriveIx ( Tycon );
+extern List deriveShow ( Tycon );
+extern List deriveRead ( Cell );
+extern List deriveBounded ( Tycon );
+extern List checkPrimDefn ( Triple );
+
+extern Void foreignImport ( Cell,Text,Pair,Cell,Cell );
+extern Void foreignExport ( Cell,Text,Cell,Cell,Cell );
+
+extern Void implementForeignImport ( Name );
+extern Void implementForeignExport ( Name );
+
+extern List foreignExports; /* foreign export declarations */
+extern List foreignImports; /* foreign import declarations */
+
+extern Type primType ( Int /*AsmMonad*/ monad,
+ String a_kinds, String r_kinds );
+
+extern Type typeCheckExp ( Bool );
+extern Void typeCheckDefns ( Void );
+extern Cell provePred ( Kinds,List,Cell );
+extern List simpleContext ( List,Int );
+extern Cell rhsExpr ( Cell );
+extern Int rhsLine ( Cell );
+extern Bool isProgType ( List,Type );
+extern Cell superEvid ( Cell,Class,Class );
+extern Void linkPreludeTC ( Void );
+extern Void linkPreludeCM ( Void );
+extern Void linkPrimNames ( Void );
+
+extern Void compiler ( Int );
+extern Void compileDefns ( Void );
+extern Void compileExp ( Void );
+extern Bool failFree ( Cell );
+extern Int discrArity ( Cell );
+
+extern Addr codeGen ( Name,Int,Cell );
+extern Void evalExp ( Void );
+extern Int shellEsc ( String );
+extern Int getTerminalWidth ( Void );
+extern Void normalTerminal ( Void );
+extern Void noechoTerminal ( Void );
+extern Int readTerminalChar ( Void );
+extern Void gcStarted ( Void );
+extern Void gcScanning ( Void );
+extern Void gcRecovered ( Int );
+extern Void gcCStack ( Void );
+extern Void needPrims ( Int );
+extern List calcFunDepsPreds ( List );
+extern Inst findInstFor ( Cell,Int );
+#if MULTI_INST
+extern List findInstsFor ( Cell,Int );
#endif
-extern Void addCfunTable Args((Tycon));
-extern Name succCfun Args((Name));
-extern Name nextCfun Args((Name,Name));
-extern Name cfunByNum Args((Name,Int));
-extern Void unwind Args((Cell));
-extern Void run Args((Addr,StackPtr));
-
-extern Void eval Args((Cell));
-extern Cell evalWithNoError Args((Cell));
-extern Void evalFails Args((StackPtr));
-
-extern Void abandon Args((String,Cell));
-extern Void outputString Args((FILE *));
-extern Void dialogue Args((Cell));
-#define consChar(c) ap(nameCons,mkChar(c))
-extern Int shellEsc Args((String));
-extern Int getTerminalWidth Args((Void));
-extern Void normalTerminal Args((Void));
-extern Void noechoTerminal Args((Void));
-extern Int readTerminalChar Args((Void));
-extern Void gcStarted Args((Void));
-extern Void gcScanning Args((Void));
-extern Void gcRecovered Args((Int));
-extern Void gcCStack Args((Void));
-extern Void needPrims Args((Int));
-extern List calcFunDepsPreds Args((List));
-extern Inst findInstFor Args((Cell,Int));
-
-extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds );
-#define aVar mkOffset(0) /* Simple skeleton for type var */
-/*-------------------------------------------------------------------------*/
+/*---------------------------------------------------------------------------
+ * Debugging printers, and output-ery
+ *-------------------------------------------------------------------------*/
+
+extern Void ppScripts ( Void );
+extern Void ppModules ( Void );
+
+extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
+
+extern Void ppStg ( Cell /*StgVar*/ v );
+extern Void ppStgExpr ( Cell /*StgExpr*/ e );
+extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
+extern Void ppStgAlts ( List alts );
+extern Void ppStgPrimAlts ( List alts );
+extern Void ppStgVars ( List vs );
+
+extern Void putChr ( Int );
+extern Void putStr ( String );
+extern Void putInt ( Int );
+extern Void putPtr ( Ptr );
+
+extern Void unlexCharConst ( Cell );
+extern Void unlexStrConst ( Text );
+extern Void unlexVar ( Text );
+extern Void unlexVarStr ( String );
+
+extern FILE *outputStream; /* current output stream */
+extern Int outColumn; /* current output column number */
+
+
+/*---------------------------------------------------------------------------
+ * For dynamic.c and general object-related stuff
+ *-------------------------------------------------------------------------*/
+
+extern void* getDLLSymbol ( Int,String,String );
+extern Bool stdcallAllowed ( void );
+
+#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
+
/*---------------------------------------------------------------------------
* Interrupting execution (signals, allowBreak):
*-------------------------------------------------------------------------*/
-extern Bool breakOn Args((Bool));
+typedef
+ enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt }
+ HugsBreakAction;
+
+extern HugsBreakAction currentBreakAction;
+extern HugsBreakAction setBreakAction ( HugsBreakAction );
-extern Bool broken; /* indicates interrupt received */
#ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
# define SIGBREAK 21
#endif
-/* allowBreak: call to allow user to interrupt computation
- * ctrlbrk: set control break handler
- */
+/* ctrlbrk: set the interrupt handler.
+ Hugs relies on being able to do sigprocmask, since some of
+ the signal handlers do longjmps, and this zaps the previous
+ signal mask. So setHandler needs to do sigprocmask in order
+ to get the signal mask to a sane state each time.
+*/
+#include <signal.h>
+#define setHandler(bh) { sigset_t mask; \
+ signal(SIGINT,bh); \
+ sigemptyset(&mask); \
+ sigaddset(&mask, SIGINT); \
+ sigprocmask(SIG_UNBLOCK, &mask, NULL); \
+ }
-#if HUGS_FOR_WINDOWS
-# define ctrlbrk(bh)
-# define allowBreak() kbhit()
-#else /* !HUGS_FOR_WINDOWS */
-# if HAVE_SIGPROCMASK
-# include <signal.h>
-# define ctrlbrk(bh) { sigset_t mask; \
- signal(SIGINT,bh); \
- sigemptyset(&mask); \
- sigaddset(&mask, SIGINT); \
- sigprocmask(SIG_UNBLOCK, &mask, NULL); \
- }
-# else
-# define ctrlbrk(bh) signal(SIGINT,bh)
-# endif
-#if SYMANTEC_C
-extern int time_release;
-extern int allow_break_count;
-# define allowBreak() if (time_release !=0 && \
- (++allow_break_count % time_release) == 0) \
- ProcessEvent();
-#else
-# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
-#endif
-#endif /* !HUGS_FOR_WINDOWS */
/*---------------------------------------------------------------------------
* Environment variables and the registry
*-------------------------------------------------------------------------*/
-/* On Win32 we can use the registry to supplement info in environment
- * variables.
- */
-/* AJG: Commented out for now for development */
-/* #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) */
-
-#ifdef USE_REGISTRY
-Bool writeRegString Args((String var, String val));
-String readRegString Args((String var, String def));
-Int readRegInt Args((String var, Int def));
-Bool writeRegInt Args((String var, Int val));
-#endif
+#define N_INSTALLDIR 200
+extern char installDir[N_INSTALLDIR];
+
/*---------------------------------------------------------------------------
* File operations:
#if HAVE_UNISTD_H
# include <sys/types.h>
# include <unistd.h>
-#elif !HUGS_FOR_WINDOWS
-extern int chdir Args((const char*));
#endif
+extern int chdir ( const char* );
+
#if HAVE_STDLIB_H
# include <stdlib.h>
#else
-extern int system Args((const char *));
-extern double atof Args((const char *));
-extern void exit Args((int));
+extern int system ( const char * );
+extern double atof ( const char * );
+extern void exit ( int );
#endif
#ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
# define filenamecmp(s1,s2) strcmp(s1,s2)
#endif
+#define HI_ENDING ".u_hi"
+
+
/*---------------------------------------------------------------------------
* Pipe-related operations:
*
#define pclose(x) _pclose(x)
#endif
+
/*---------------------------------------------------------------------------
* Bit manipulation:
*-------------------------------------------------------------------------*/
#define placeInSet(n) ((-(n)-1)>>wordShift)
#define maskInSet(n) (1<<((-(n)-1)&wordMask))
+
/*---------------------------------------------------------------------------
* Function prototypes for code in machdep.c
*-------------------------------------------------------------------------*/
-extern String findMPathname Args((String,String,String));
-extern String findPathname Args((String,String));
+extern String findMPathname ( String,String,String );
+extern String findPathname ( String,String );
+extern Int shellEsc ( String );
+extern Int getTerminalWidth ( Void );
+extern Void normalTerminal ( Void );
+extern Void noechoTerminal ( Void );
+extern Int readTerminalChar ( Void );
+extern Void gcStarted ( Void );
+extern Void gcScanning ( Void );
+extern Void gcRecovered ( Int );
+extern Void gcCStack ( Void );
-extern Int shellEsc Args((String));
-extern Int getTerminalWidth Args((Void));
-extern Void normalTerminal Args((Void));
-extern Void noechoTerminal Args((Void));
-extern Int readTerminalChar Args((Void));
-extern Void gcStarted Args((Void));
-extern Void gcScanning Args((Void));
-extern Void gcRecovered Args((Int));
-extern Void gcCStack Args((Void));
-/*-------------------------------------------------------------------------*/
+/*---------------------------------------------------------------------------
+ * To do with reading interface and object files
+ *-------------------------------------------------------------------------*/
-extern Type typeInt64;
-extern Type typeWord;
-extern Type typeFloat;
-extern Type typePrimArray;
-extern Type typePrimByteArray;
-extern Type typeRef;
-extern Type typePrimMutableArray;
-extern Type typePrimMutableByteArray;
-extern Type typeStable;
-extern Type typeWeak;
-extern Type typeIO;
-extern Type typeForeign;
-extern Type typeMVar;
-extern Type typeThreadId;
-extern Type typeException;
-extern Type typeIO;
-extern Type typeST;
+extern Cell parseInterface ( String,Long );
+extern List getInterfaceImports ( Cell );
+extern void processInterfaces ( List );
+extern Void getFileSize ( String, Long * );
+extern Void ifLinkConstrItbl ( Name n );
+extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
+extern void* lookupObjName ( char* );
-extern Void foreignImport Args((Cell,Text,Pair,Cell,Cell));
-extern List foreignImports; /* foreign import declarations */
-extern Void implementForeignImport Args((Name));
-extern Void foreignExport Args((Cell,Text,Cell,Cell,Cell));
-extern List foreignExports; /* foreign export declarations */
-extern Void implementForeignExport Args((Name));
+extern String getExtraObjectInfo ( String primaryObjectName,
+ String extraFileName,
+ Int* extraFileSize );
-extern List diVars;
-extern Int diNum;
+extern List /* of ZTriple(I_INTERFACE,
+ Text--name of obj file,
+ Int--size of obj file) */
+ ifaces_outstanding;
-Int userArity Args((Name));
+/* --------------------------------------------------------------------------
+ * Interpreter command structure
+ * ------------------------------------------------------------------------*/
-extern List deriveEq Args((Tycon));
-extern List deriveOrd Args((Tycon));
-extern List deriveEnum Args((Tycon));
-extern List deriveIx Args((Tycon));
-extern List deriveShow Args((Tycon));
-extern List deriveRead Args((Cell));
-extern List deriveBounded Args((Tycon));
-extern List checkPrimDefn Args((Triple));
+typedef Int Command;
+
+struct cmd {
+ String cmdString;
+ Command cmdCode;
+};
+
+extern Command readCommand ( struct cmd *, Char, Char );
+
+#define EDIT 0
+#define FIND 1
+#define LOAD 2
+#define ALSO 3
+#define PROJECT 4
+#define RELOAD 5
+#define EVAL 6
+#define TYPEOF 7
+#define HELP 8
+#define NAMES 9
+#define BADCMD 10
+#define SET 11
+#define QUIT 12
+#define SYSTEM 13
+#define CHGDIR 14
+#define INFO 15
+#define COLLECT 16
+#define SETMODULE 17
+#define DUMP 18
+#define STATS 19
+#define BROWSE 20
+#define XPLAIN 21
+#define PNTVER 22
+#define NOCMD 23
-extern Bool typeMatches Args((Type,Type));
-extern Void evalExp Args((Void));
-extern Void linkControl Args((Int));
-extern Void deriveControl Args((Int));
-extern Void translateControl Args((Int));
-extern Void codegen Args((Int));
-extern Void machdep Args((Int));
-extern Void linkPreludeNames(void);
+/* --------------------------------------------------------------------------
+ * STG Syntax:
+ *
+ * Rhs -> STGCON (Con, [Atom])
+ * | STGAPP (Var, [Atom]) -- delayed application
+ * | Expr
+ *
+ * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
+ * | LAMBDA ([Var],Expr) -- all vars bound to NIL
+ * | CASE (Expr,[Alt]) -- algebraic case
+ * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
+ * | STGPRIM (Prim,[Atom])
+ * | STGAPP (Var, [Atom]) -- tail call
+ * | Var -- Abbreviation for STGAPP(Var,[])
+ *
+ * Atom -> Var
+ * | CHAR -- unboxed
+ * | INT -- unboxed
+ * | BIGNUM -- unboxed
+ * | FLOAT -- unboxed
+ * | ADDR -- unboxed
+ * | STRING -- boxed
+ *
+ * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
+ * | Name -- let-bound (effectively)
+ * -- always unboxed (PTR_REP)
+ *
+ * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
+ * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
+ * -- Con is Name or TUPLE
+ * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
+ *
+ * We use pointer equality to distinguish variables.
+ * The info field of a Var is used as follows in various phases:
+ *
+ * Translation: unused (set to NIL on output)
+ * Freevar analysis: list of free vars after
+ * Lambda lifting: freevar list or UNIT on input, discarded after
+ * Code generation: unused
+ * ------------------------------------------------------------------------*/
-extern Kind starToStar; /* Type -> Type */
-extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
-extern Type typeOrdering;
+typedef Cell StgRhs;
+typedef Cell StgExpr;
+typedef Cell StgAtom;
+typedef Cell StgVar; /* Could be a Name or an STGVAR */
+typedef Cell StgCaseAlt;
+typedef Cell StgPrimAlt;
+typedef Cell StgDiscr;
+typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
-extern Type conToTagType Args((Tycon));
-extern Type tagToConType Args((Tycon));
+#define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
+#define stgLetBinds(e) fst(snd(e))
+#define stgLetBody(e) snd(snd(e))
-#define BOGUS(k) (-9000000-(k))
+#define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
+#define stgVarBody(e) fst3(snd(e))
+#define stgVarRep(e) snd3(snd(e))
+#define stgVarInfo(e) thd3(snd(e))
-extern Void putChr Args((Int));
-extern Void putStr Args((String));
-extern Void putInt Args((Int));
-extern Void putPtr Args((Ptr));
+#define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
+#define stgCaseScrut(e) fst(snd(e))
+#define stgCaseAlts(e) snd(snd(e))
-extern Void unlexCharConst Args((Cell));
-extern FILE *outputStream; /* current output stream */
-extern Int outColumn; /* current output column number */
+#define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e))
+#define stgCaseAltCon(alt) fst3(snd(alt))
+#define stgCaseAltVars(alt) snd3(snd(alt))
+#define stgCaseAltBody(alt) thd3(snd(alt))
+
+#define mkStgDefault(v,e) ap(DEEFALT,pair(v,e))
+#define stgDefaultVar(alt) fst(snd(alt))
+#define stgDefaultBody(alt) snd(snd(alt))
+#define isDefaultAlt(alt) (fst(alt)==DEEFALT)
+
+#define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
+#define stgPrimCaseScrut(e) fst(snd(e))
+#define stgPrimCaseAlts(e) snd(snd(e))
+
+#define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
+#define stgPrimAltVars(alt) fst(snd(alt))
+#define stgPrimAltBody(alt) snd(snd(alt))
+
+#define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
+#define stgAppFun(e) fst(snd(e))
+#define stgAppArgs(e) snd(snd(e))
+
+#define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
+#define stgPrimOp(e) fst(snd(e))
+#define stgPrimArgs(e) snd(snd(e))
+
+#define mkStgCon(con,args) ap(STGCON,pair(con,args))
+#define stgConCon(e) fst(snd(e))
+#define stgConArgs(e) snd(snd(e))
+
+#define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
+#define stgLambdaArgs(e) fst(snd(e))
+#define stgLambdaBody(e) snd(snd(e))
+
+
+/* --------------------------------------------------------------------------
+ * Utility functions for manipulating STG syntax trees.
+ * ------------------------------------------------------------------------*/
+
+extern int stgConTag ( StgDiscr d );
+extern void* stgConInfo ( StgDiscr d );
+extern int stgDiscrTag ( StgDiscr d );
+
+extern List makeArgs ( Int );
+extern StgExpr makeStgLambda ( List args, StgExpr body );
+extern StgExpr makeStgApp ( StgVar fun, List args );
+extern StgExpr makeStgLet ( List binds, StgExpr body );
+extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 );
+extern Bool isStgVar ( StgRhs rhs );
+extern Bool isAtomic ( StgRhs rhs );
+extern StgVar mkStgVar ( StgRhs rhs, Cell info );
-extern Void unlexStrConst Args((Text));
-extern Void unlexVar Args((Text));
-extern List offsetTyvarsIn Args((Type,List));
+#define mkStgRep(c) mkChar(c)
-extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
-extern Void interface Args((Int));
+/* --------------------------------------------------------------------------
+ * STG/backendish functions
+ * ------------------------------------------------------------------------*/
+
+extern Void stgDefn ( Name n, Int arity, Cell e );
+
+extern Void implementForeignImport ( Name );
+extern Void implementForeignExport ( Name );
+extern Void implementCfun ( Name, List );
+extern Void implementConToTag ( Tycon );
+extern Void implementTagToCon ( Tycon );
+extern Void implementPrim ( Name );
+extern Void implementTuple ( Int );
+#if TREX
+extern Name implementRecShw ( Text );
+extern Name implementRecEq ( Text );
+#endif
+
+extern void liftModule ( Module );
+extern StgExpr substExpr ( List sub, StgExpr e );
+extern List freeVarsBind ( List, StgVar );
+
+
+extern Void cgModule ( Module );
+extern char* lookupHugsName ( void* );
-extern Void getFileSize Args((String, Long *));
-extern Void loadInterface Args((String,Long));
+/* --------------------------------------------------------------------------
+ * Definitions for substitution data structure and operations.
+ * ------------------------------------------------------------------------*/
+
+typedef struct { /* Each type variable contains: */
+ Type bound; /* A type skeleton (unbound==NIL) */
+ Int offs; /* Offset for skeleton */
+ Kind kind; /* kind annotation */
+} Tyvar;
+
+extern Tyvar *tyvars; /* storage for type variables */
+extern Int typeOff; /* offset of result type */
+extern Type typeIs; /* skeleton of result type */
+extern Int typeFree; /* freedom in instantiated type */
+extern List predsAre; /* list of predicates in type */
+extern List genericVars; /* list of generic vars */
+extern List btyvars; /* explicitly scoped type vars */
+
+#define tyvar(n) (tyvars+(n)) /* nth type variable */
+#define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
+#define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
+#define aVar mkOffset(0) /* Simple skeletons for type vars */
+#define bVar mkOffset(1)
+#define enterBtyvs() btyvars = cons(NIL,btyvars)
+#define leaveBtyvs() btyvars = tl(btyvars)
+
+#define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
+ t = tyv->bound; \
+ o = tyv->offs; \
+ }
+
+ /* offs values when isNull(bound): */
+#define FIXED_TYVAR 0 /* fixed in current assumption */
+#define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
+#define GENERIC 2 /* GENERIC+n==nth generic var found*/
+
+extern char *unifyFails; /* Unification error message */
+
+extern Void emptySubstitution ( Void );
+extern Int newTyvars ( Int );
+#define newKindvars(n) newTyvars(n)
+extern Int newKindedVars ( Kind );
+extern Kind simpleKind ( Int );
+extern Void instantiate ( Type );
+
+extern Pair findBtyvs ( Text );
+extern Void markBtyvs ( Void );
+extern Type localizeBtyvs ( Type );
+
+extern Tyvar *getTypeVar ( Type,Int );
+extern Void tyvarType ( Int );
+extern Void bindTv ( Int,Type,Int );
+extern Cell getDerefHead ( Type,Int );
+extern Void expandSyn ( Tycon, Int, Type *, Int * );
+
+extern Void clearMarks ( Void );
+extern Void markAllVars ( Void );
+extern Void resetGenerics ( Void );
+extern Void markTyvar ( Int );
+extern Void markType ( Type,Int );
+extern Void markPred ( Cell );
+
+extern Type copyTyvar ( Int );
+extern Type copyType ( Type,Int );
+extern Cell copyPred ( Cell,Int );
+extern Type dropRank2 ( Type,Int,Int );
+extern Type dropRank1 ( Type,Int,Int );
+extern Void liftRank2Args ( List,Int,Int );
+extern Type liftRank2 ( Type,Int,Int );
+extern Type liftRank1 ( Type,Int,Int );
+#ifdef DEBUG_TYPES
+extern Type debugTyvar ( Int );
+extern Type debugType ( Type,Int );
+#endif
+extern Kind copyKindvar ( Int );
+extern Kind copyKind ( Kind,Int );
-extern Void openGHCIface Args((Text));
-extern Void loadSharedLib Args((String));
-extern Void addGHCImports Args((Int,Text,List));
-extern Void addGHCExports Args((Cell,List));
-extern Void addGHCVar Args((Int,Text,Type));
-extern Void addGHCSynonym Args((Int,Cell,List,Type));
-extern Void addGHCDataDecl Args((Int,List,Cell,List,List));
-extern Void addGHCNewType Args((Int,List,Cell,List,Cell));
-extern Void addGHCClass Args((Int,List,Cell,List,List));
-extern Void addGHCInstance Args((Int,List,Pair,Text));
-extern Void finishInterfaces Args((Void));
+extern Bool eqKind ( Kind,Kind );
+extern Kind getKind ( Cell,Int );
-extern Void hi_o_namesFromSrcName Args((String,String*,String* oName));
-extern Void parseInterface Args((String,Long));
+extern List genvarTyvar ( Int,List );
+extern List genvarType ( Type,Int,List );
+extern Bool doesntOccurIn ( Tyvar*,Type,Int );
+extern Bool unify ( Type,Int,Type,Int );
+extern Bool kunify ( Kind,Int,Kind,Int );
-#define SMALL_INLINE_SIZE 9
+extern Void typeTuple ( Cell );
+extern Void varKind ( Int );
+extern Bool samePred ( Cell,Int,Cell,Int );
+extern Bool matchPred ( Cell,Int,Cell,Int );
+extern Bool unifyPred ( Cell,Int,Cell,Int );
+extern Inst findInstFor ( Cell,Int );
-// nasty hack, but seems an easy to convey the object name
-// and size to openGHCIface
-char nameObj[FILENAME_MAX+1];
-int sizeObj;
+extern Void improve ( Int,List,List );
+extern Void improve1 ( Int,List,Cell,Int );
+extern Bool sameSchemes ( Type,Type );
+extern Bool sameType ( Type,Int,Type,Int );
+extern Bool matchType ( Type,Int,Type,Int );
+extern Bool typeMatches ( Type,Type );
+
+#ifdef DEBUG
+extern Void checkBytecodeCount ( Void );
+#endif
+/*-------------------------------------------------------------------------*/
projects / ghc-hetmet.git / blobdiff