/* --------------------------------------------------------------------------
* Connections between components of the Hugs system
*
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: connect.h,v $
- * $Revision: 1.3 $
- * $Date: 1999/02/03 17:08:27 $
+ * $Revision: 1.25 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
* ------------------------------------------------------------------------*/
extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
+extern Bool combined; /* TRUE => combined operation */
extern Module modulePrelude;
-extern Module modulePreludeHugs;
/* --------------------------------------------------------------------------
* Primitive constructor functions
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 nameReturn, nameBind; /* for translating monad comps */
extern Name nameMFail;
extern Name nameListMonad; /* builder function for List Monad */
-
-#if EVAL_INSTANCES
-extern Name nameStrict, nameSeq; /* Members of class Eval */
-extern Name nameIStrict, nameISeq; /* ... and their implementations */
-#endif
-
extern Name namePrint; /* printing primitive */
-
-#if IO_MONAD
-extern Type typeProgIO; /* For the IO monad, IO () */
-extern Name nameIORun; /* IO monad executor */
-extern Name namePutStr; /* Prelude.putStr */
-extern Name nameUserErr; /* primitives required for IOError */
-extern Name nameNameErr, nameSearchErr;
-#endif
-
-#if IO_HANDLES
-extern Name nameWriteErr, nameIllegal;/* primitives required for IOError */
-extern Name nameEOFErr;
-#endif
-
+extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */
extern Text textPrelude;
extern Text textNum; /* used to process default decls */
-#if NPLUSK
+extern Text textCcall; /* used to process foreign import */
+extern Text textStdcall; /* ... and foreign export */
extern Text textPlus; /* Used to recognise n+k patterns */
-#endif
+
#if TREX
extern Name nameNoRec; /* The empty record */
extern Type typeNoRow; /* The empty row */
extern String hugsPath; /* String for file search path */
extern String projectPath; /* String for project search path */
+extern Type typeProgIO; /* For the IO monad, IO a */
extern Type typeArrow; /* Builtin type constructors */
extern Type typeList;
extern Type typeUnit;
extern Class classRead;
extern Class classIx;
extern Class classEnum;
-#if EVAL_INSTANCES
-extern Class classEval;
-#endif
extern Class classBounded;
extern Class classReal; /* `numeric' classes */
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 */
-/*ToDo?? extern Long numReductions;*/ /* number of reductions used */
extern Long numCells; /* number of cells allocated */
extern Int numGcs; /* number of garbage collections */
extern Bool broken; /* indicates interrupt received */
-/*ToDo?? extern Bool preludeLoaded;*/ /* TRUE => prelude has been loaded */
+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 */
-/*ToDo?? extern Bool failOnError;*/ /* TRUE => error produces immediate*/
- /* termination */
+extern Bool showInstRes; /* TRUE => show instance resolution */
extern Int cutoff; /* Constraint Cutoff depth */
#if DEBUG_CODE
extern Bool debugCode; /* TRUE => print G-code to screen */
#endif
+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 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 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 invariantss after GC */
+
+/* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
+ in the old Hugs.
+*/
+
typedef long Target;
extern Void setGoal Args((String, Target));
extern Void stringInput Args((String));
extern Void parseScript Args((String,Long));
extern Void parseExp Args((Void));
+#if EXPLAIN_INSTANCE_RESOLUTION
+extern Void parseContext Args((Void));
+#endif
extern String readFilename Args((Void));
extern String readLine Args((Void));
extern Syntax defaultSyntax Args((Text));
extern Void printString Args((String));
extern Void substitution Args((Int));
+extern Void optimiser Args((Int));
extern Void staticAnalysis Args((Int));
-#if IGNORE_MODULES
-#define startModule(m) doNothing()
-#define setExportList(l) doNothing()
-#define setExports(l) doNothing()
-#define addQualImport(m,as) doNothing()
-#define addUnqualImport(m,l) doNothing()
-#else
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));
-#endif
+
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,Cell));
+extern Void classDefn Args((Int,Cell,List,List));
extern Void instDefn Args((Int,Cell,Cell));
extern Void addTupInst Args((Class,Int));
-#if EVAL_INSTANCES
-extern Void addEvalInst Args((Int,Cell,Int,List));
-#endif
#if TREX
extern Inst addRecShowInst Args((Class,Ext));
extern Inst addRecEqInst Args((Class,Ext));
#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));
+#if EXPLAIN_INSTANCE_RESOLUTION
+extern Void checkContext Args((Void));
+#endif
extern Void checkDefns Args((Void));
extern Bool h98Pred Args((Bool,Cell));
extern Cell h98Context Args((Bool,List));
extern Cell evalWithNoError Args((Cell));
extern Void evalFails Args((StackPtr));
-#if BYTECODE_PRIMS
-extern Int IntAt Args((Addr));
-#if !BREAK_FLOATS
-extern Float FloatAt Args((Addr));
-#endif
-extern Cell CellAt Args((Addr));
-extern Text TextAt Args((Addr));
-extern Addr AddrAt Args((Addr));
-extern Int InstrAt Args((Addr));
-#endif /* BYTECODE_PRIMS */
-
extern Void abandon Args((String,Cell));
extern Void outputString Args((FILE *));
extern Void dialogue Args((Cell));
-#define consChar(c) ap(conCons,mkChar(c))
-
-#if BIGNUMS
-extern Bignum bigInt Args((Int));
-extern Bignum bigDouble Args((double));
-extern Bignum bigNeg Args((Bignum));
-extern Cell bigToInt Args((Bignum));
-extern Cell bigToFloat Args((Bignum));
-extern Bignum bigStr Args((String));
-extern Cell bigOut Args((Bignum,Cell,Bool));
-extern Bignum bigShift Args((Bignum,Int,Int));
-extern Int bigCmp Args((Bignum,Bignum));
-#endif
-#if IO_MONAD
-extern Void setHugsArgs Args((Int,String[]));
-#endif
-
-#if PROFILING
-extern String timeString Args((Void));
-#endif
+#define consChar(c) ap(nameCons,mkChar(c))
extern Int shellEsc Args((String));
extern Int getTerminalWidth 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));
+#if MULTI_INST
+extern List findInstsFor Args((Cell,Int));
+#endif
+
+extern Void ppScripts ( Void );
+extern Void ppModules ( Void );
extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds );
#define aVar mkOffset(0) /* Simple skeleton for type var */
# define ctrlbrk(bh)
# define allowBreak() kbhit()
#else /* !HUGS_FOR_WINDOWS */
-# define ctrlbrk(bh) signal(SIGINT,bh); signal(SIGBREAK,bh)
-# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
+# 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 */
/*---------------------------------------------------------------------------
/* On Win32 we can use the registry to supplement info in environment
* variables.
*/
-#define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__)
+/* AJG: Commented out for now for development */
+/* #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) */
#ifdef USE_REGISTRY
Bool writeRegString Args((String var, String val));
Bool writeRegInt Args((String var, Int val));
#endif
+#define N_INSTALLDIR 200
+extern char installDir[N_INSTALLDIR];
+
/*---------------------------------------------------------------------------
* File operations:
*-------------------------------------------------------------------------*/
extern Type typeIO;
extern Type typeST;
-extern Void foreignImport Args((Cell,Pair,Cell,Cell));
+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,Cell,Cell,Cell));
+extern Void foreignExport Args((Cell,Text,Cell,Cell,Cell));
extern List foreignExports; /* foreign export declarations */
extern Void implementForeignExport Args((Name));
extern Void deriveControl Args((Int));
extern Void translateControl Args((Int));
extern Void codegen Args((Int));
+extern Void machdep Args((Int));
+
+extern Void linkPrimitiveNames(void);
+
+extern Kind starToStar; /* Type -> Type */
+extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
+extern Type typeOrdering;
+
+extern Type conToTagType Args((Tycon));
+extern Type tagToConType Args((Tycon));
+
+#define BOGUS(k) (-9000000-(k))
+
+extern Void putChr Args((Int));
+extern Void putStr Args((String));
+extern Void putInt Args((Int));
+extern Void putPtr Args((Ptr));
+
+extern Void unlexCharConst Args((Cell));
+extern FILE *outputStream; /* current output stream */
+extern Int outColumn; /* current output column number */
+
+extern Void unlexStrConst Args((Text));
+extern Void unlexVar Args((Text));
+extern Void unlexVarStr Args((String));
+extern List offsetTyvarsIn Args((Type,List));
+
+extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
+
+extern Void interface Args((Int));
+
+extern Void getFileSize Args((String, Long *));
+
+extern ZPair readInterface Args((String,Long));
+extern Bool processInterfaces Args((Void));
+extern void ifLinkConstrItbl ( Name n );
+
+
+extern List /* of ZTriple(I_INTERFACE,
+ Text--name of obj file,
+ Int--size of obj file) */
+ ifaces_outstanding;
+
+
+extern Void hi_o_namesFromSrcName Args((String,String*,String* oName));
+extern Cell parseInterface Args((String,Long));
+
+extern String getExtraObjectInfo ( String primaryObjectName,
+ String extraFileName,
+ Int* extraFileSize );
+
+extern Name newDSel Args((Class,Int));
+extern Int visitClass Args((Class));
+
+extern Kind simpleKind Args((Int));
projects / ghc-hetmet.git / blobdiff