1 /* --------------------------------------------------------------------------
2 * Connections between components of the Hugs system
4 * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
5 * Haskell Group 1994-99, and is distributed as Open Source software
6 * under the Artistic License; see the file "Artistic" that is included
7 * in the distribution for details.
9 * $RCSfile: connect.h,v $
11 * $Date: 1999/06/07 17:22:45 $
12 * ------------------------------------------------------------------------*/
14 /* --------------------------------------------------------------------------
16 * ------------------------------------------------------------------------*/
18 extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
19 extern Module modulePrelude;
21 /* --------------------------------------------------------------------------
22 * Primitive constructor functions
23 * ------------------------------------------------------------------------*/
25 extern Name nameFalse, nameTrue;
26 extern Name nameNil, nameCons;
27 extern Name nameJust, nameNothing;
28 extern Name nameLeft, nameRight;
31 extern Name nameLT, nameEQ;
33 extern Name nameFst, nameSnd; /* standard combinators */
34 extern Name nameId, nameOtherwise;
35 extern Name nameNegate, nameFlip; /* primitives reqd for parsing */
36 extern Name nameFrom, nameFromThen;
37 extern Name nameFromTo, nameFromThenTo;
38 extern Name nameFatbar, nameFail; /* primitives reqd for translation */
39 extern Name nameIf, nameSel;
40 extern Name nameCompAux;
41 extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
42 extern Name namePmInteger;
44 extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */
46 extern Name nameError; /* For runtime error messages */
47 extern Name nameUndefined; /* A generic undefined value */
48 extern Name nameBlackHole; /* For GC-detected black hole */
49 extern Name nameInd; /* For dict indirection */
50 extern Name nameAnd, nameOr; /* For optimisation of && and || */
51 extern Name nameFromInt, nameFromDouble;/*coercion of numerics */
52 extern Name nameFromInteger;
53 extern Name nameEq, nameCompare; /* names used for deriving */
54 extern Name nameMinBnd, nameMaxBnd;
55 extern Name nameIndex, nameInRange;
56 extern Name nameRange;
57 extern Name nameLe, nameGt;
58 extern Name nameShowsPrec, nameReadsPrec;
59 extern Name nameMult, namePlus;
60 extern Name nameConCmp, nameEnRange;
61 extern Name nameEnIndex, nameEnInRng;
62 extern Name nameEnToEn, nameEnFrEn;
63 extern Name nameEnFrom, nameEnFrTh;
64 extern Name nameEnFrTo;
65 extern Name nameComp, nameApp; /* composition and append */
66 extern Name nameShowField; /* display single field */
67 extern Name nameShowParen; /* wrap with parens */
68 extern Name nameReadField; /* read single field */
69 extern Name nameReadParen; /* unwrap from parens */
70 extern Name nameLex; /* lexer */
71 extern Name nameRangeSize; /* calculate size of index range */
72 extern Class classMonad; /* Monads */
73 extern Name nameReturn, nameBind; /* for translating monad comps */
74 extern Name nameMFail;
75 extern Name nameListMonad; /* builder function for List Monad */
76 extern Name namePrint; /* printing primitive */
77 extern Text textPrelude;
78 extern Text textNum; /* used to process default decls */
80 extern Text textPlus; /* Used to recognise n+k patterns */
83 extern Name nameNoRec; /* The empty record */
84 extern Type typeNoRow; /* The empty row */
85 extern Type typeRec; /* Record formation */
86 extern Kind extKind; /* Kind of extension, *->row->row */
87 extern Name nameRecExt; /* Extend a record */
88 extern Name nameRecBrk; /* Break a record */
89 extern Name nameAddEv; /* Addition of evidence values */
90 extern Name nameRecSel; /* Select a record */
91 extern Name nameRecShw; /* Show a record */
92 extern Name nameShowRecRow; /* Used to output rows */
93 extern Name nameRecEq; /* Compare records */
94 extern Name nameEqRecRow; /* Used to compare rows */
95 extern Name nameInsFld; /* Field insertion routine */
98 extern String repeatStr; /* Repeat last command string */
99 extern String hugsEdit; /* String for editor command */
100 extern String hugsPath; /* String for file search path */
101 extern String projectPath; /* String for project search path */
103 extern Type typeArrow; /* Builtin type constructors */
104 extern Type typeList;
105 extern Type typeUnit;
107 #define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */
109 extern List stdDefaults; /* List of standard default types */
111 extern Class classEq; /* `standard' classes */
112 extern Class classOrd;
113 extern Class classShow;
114 extern Class classRead;
115 extern Class classIx;
116 extern Class classEnum;
117 extern Class classBounded;
119 extern Class classReal; /* `numeric' classes */
120 extern Class classIntegral;
121 extern Class classRealFrac;
122 extern Class classRealFloat;
123 extern Class classFractional;
124 extern Class classFloating;
125 extern Class classNum;
127 extern Cell *CStackBase; /* pointer to base of C stack */
129 extern List tyconDefns; /* list of type constructor defns */
130 extern List typeInDefns; /* list of synonym restrictions */
131 extern List valDefns; /* list of value definitions */
132 extern List classDefns; /* list of class definitions */
133 extern List instDefns; /* list of instance definitions */
134 extern List selDefns; /* list of selector lists */
135 extern List genDefns; /* list of generated defns */
136 extern List primDefns; /* list of primitive definitions */
137 extern List unqualImports; /* unqualified import list */
138 extern List defaultDefns; /* default definitions (if any) */
139 extern Int defaultLine; /* line in which default defs occur*/
140 extern List evalDefaults; /* defaults for evaluator */
141 extern Cell inputExpr; /* evaluator input expression */
142 extern Addr inputCode; /* Code for compiled input expr */
144 extern Int whnfArgs; /* number of args of term in whnf */
145 extern Cell whnfHead; /* head of term in whnf */
146 extern Int whnfInt; /* integer value of term in whnf */
147 extern Float whnfFloat; /* float value of term in whnf */
148 extern Long numCells; /* number of cells allocated */
149 extern Int numGcs; /* number of garbage collections */
150 extern Bool broken; /* indicates interrupt received */
151 extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
153 extern Bool gcMessages; /* TRUE => print GC messages */
154 extern Bool literateScripts; /* TRUE => default lit scripts */
155 extern Bool literateErrors; /* TRUE => report errs in lit scrs */
156 extern Bool optimise; /* TRUE => simplify STG */
158 extern Int cutoff; /* Constraint Cutoff depth */
161 extern String preprocessor; /* preprocessor command */
165 extern Bool debugCode; /* TRUE => print G-code to screen */
167 extern Bool kindExpert; /* TRUE => display kind errors in */
169 extern Bool allowOverlap; /* TRUE => allow overlapping insts */
171 /* --------------------------------------------------------------------------
172 * Function prototypes etc...
173 * ------------------------------------------------------------------------*/
175 extern Void everybody Args((Int));
177 #define RESET 1 /* reset subsystem */
178 #define MARK 2 /* mark parts of graph in use by subsystem */
179 #define INSTALL 3 /* install subsystem (executed once only) */
180 #define EXIT 4 /* Take action immediately before exit() */
181 #define BREAK 5 /* Take action after program break */
182 #define GCDONE 6 /* Restore subsystem invariantss after GC */
185 extern Void setGoal Args((String, Target));
186 extern Void soFar Args((Target));
187 extern Void done Args((Void));
188 extern String fromEnv Args((String,String));
189 extern Bool chase Args((List));
191 extern Void storage Args((Int));
193 extern Void input Args((Int));
194 extern Void consoleInput Args((String));
195 extern Void projInput Args((String));
196 extern Void stringInput Args((String));
197 extern Void parseScript Args((String,Long));
198 extern Void parseExp Args((Void));
199 extern String readFilename Args((Void));
200 extern String readLine Args((Void));
201 extern Syntax defaultSyntax Args((Text));
202 extern Syntax syntaxOf Args((Name));
203 extern String unlexChar Args((Char,Char));
204 extern Void printString Args((String));
206 extern Void substitution Args((Int));
207 extern Void optimiser Args((Int));
209 extern Void staticAnalysis Args((Int));
210 extern Void startModule Args((Cell));
211 extern Void setExportList Args((List));
212 extern Void setExports Args((List));
213 extern Void addQualImport Args((Text,Text));
214 extern Void addUnqualImport Args((Text,List));
216 extern Void tyconDefn Args((Int,Cell,Cell,Cell));
217 extern Void setTypeIns Args((List));
218 extern Void clearTypeIns Args((Void));
219 extern Type fullExpand Args((Type));
220 extern Bool isAmbiguous Args((Type));
221 extern Void ambigError Args((Int,String,Cell,Type));
222 extern Void classDefn Args((Int,Cell,Cell));
223 extern Void instDefn Args((Int,Cell,Cell));
224 extern Void addTupInst Args((Class,Int));
226 extern Inst addRecShowInst Args((Class,Ext));
227 extern Inst addRecEqInst Args((Class,Ext));
229 extern Void primDefn Args((Cell,List,Cell));
230 extern Void defaultDefn Args((Int,List));
231 extern Void checkExp Args((Void));
232 extern Void checkDefns Args((Void));
233 extern Bool h98Pred Args((Bool,Cell));
234 extern Cell h98Context Args((Bool,List));
235 extern Void h98CheckCtxt Args((Int,String,Bool,List,Inst));
236 extern Void h98CheckType Args((Int,String,Cell,Type));
237 extern Void h98DoesntSupport Args((Int,String));
239 extern Void typeChecker Args((Int));
240 extern Type typeCheckExp Args((Bool));
241 extern Void typeCheckDefns Args((Void));
242 extern Cell provePred Args((Kinds,List,Cell));
243 extern List simpleContext Args((List,Int));
244 extern Cell rhsExpr Args((Cell));
245 extern Int rhsLine Args((Cell));
246 extern Bool isProgType Args((List,Type));
247 extern Cell superEvid Args((Cell,Class,Class));
248 extern Void linkPreludeTC Args((Void));
249 extern Void linkPreludeCM Args((Void));
251 extern Void compiler Args((Int));
252 extern Void compileDefns Args((Void));
253 extern Void compileExp Args((Void));
254 extern Bool failFree Args((Cell));
255 extern Int discrArity Args((Cell));
257 extern Addr codeGen Args((Name,Int,Cell));
258 extern Void implementCfun Args((Name,List));
260 extern Name implementRecShw Args((Text,Cell));
261 extern Name implementRecEq Args((Text,Cell));
263 extern Void addCfunTable Args((Tycon));
264 extern Name succCfun Args((Name));
265 extern Name nextCfun Args((Name,Name));
266 extern Name cfunByNum Args((Name,Int));
267 extern Void unwind Args((Cell));
268 extern Void run Args((Addr,StackPtr));
270 extern Void eval Args((Cell));
271 extern Cell evalWithNoError Args((Cell));
272 extern Void evalFails Args((StackPtr));
274 extern Void abandon Args((String,Cell));
275 extern Void outputString Args((FILE *));
276 extern Void dialogue Args((Cell));
277 #define consChar(c) ap(nameCons,mkChar(c))
279 extern Int shellEsc Args((String));
280 extern Int getTerminalWidth Args((Void));
281 extern Void normalTerminal Args((Void));
282 extern Void noechoTerminal Args((Void));
283 extern Int readTerminalChar Args((Void));
284 extern Void gcStarted Args((Void));
285 extern Void gcScanning Args((Void));
286 extern Void gcRecovered Args((Int));
287 extern Void gcCStack Args((Void));
288 extern Void needPrims Args((Int));
290 extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds );
291 #define aVar mkOffset(0) /* Simple skeleton for type var */
293 /*-------------------------------------------------------------------------*/
295 /*---------------------------------------------------------------------------
296 * Interrupting execution (signals, allowBreak):
297 *-------------------------------------------------------------------------*/
299 extern Bool breakOn Args((Bool));
301 extern Bool broken; /* indicates interrupt received */
303 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
307 /* allowBreak: call to allow user to interrupt computation
308 * ctrlbrk: set control break handler
313 # define allowBreak() kbhit()
314 #else /* !HUGS_FOR_WINDOWS */
315 # define ctrlbrk(bh) signal(SIGINT,bh); signal(SIGBREAK,bh)
316 # define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
317 #endif /* !HUGS_FOR_WINDOWS */
319 /*---------------------------------------------------------------------------
320 * Environment variables and the registry
321 *-------------------------------------------------------------------------*/
323 /* On Win32 we can use the registry to supplement info in environment
326 #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__)
329 Bool writeRegString Args((String var, String val));
330 String readRegString Args((String var, String def));
331 Int readRegInt Args((String var, Int def));
332 Bool writeRegInt Args((String var, Int val));
335 /*---------------------------------------------------------------------------
337 *-------------------------------------------------------------------------*/
340 # include <sys/types.h>
342 #elif !HUGS_FOR_WINDOWS
343 extern int chdir Args((const char*));
349 extern int system Args((const char *));
350 extern double atof Args((const char *));
351 extern void exit Args((int));
354 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
355 #define FILENAME_MAX 256
357 #if FILENAME_MAX < 256
359 #define FILENAME_MAX 256
363 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
364 #define DOS_FILENAMES HAVE_DOS_H
365 /* ToDo: can we replace this with a feature test? */
366 #define MAC_FILENAMES SYMANTEC_C
368 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
370 #if CASE_INSENSITIVE_FILENAMES
372 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
374 # define filenamecmp(s1,s2) _stricmp(s1,s2)
376 # define filenamecmp(s1,s2) stricmp(s1,s2)
378 # define filenamecmp(s1,s2) strcmpi(s1,s2)
381 # define filenamecmp(s1,s2) strcmp(s1,s2)
384 /*---------------------------------------------------------------------------
385 * Pipe-related operations:
387 * On Windows, many standard Unix names acquire a leading underscore.
388 * Irritating, but easy to work around.
389 *-------------------------------------------------------------------------*/
391 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
392 #define popen(x,y) _popen(x,y)
394 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
395 #define pclose(x) _pclose(x)
398 /*---------------------------------------------------------------------------
400 *-------------------------------------------------------------------------*/
402 #define bitArraySize(n) ((n)/bitsPerWord + 1)
403 #define placeInSet(n) ((-(n)-1)>>wordShift)
404 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
406 /*---------------------------------------------------------------------------
407 * Function prototypes for code in machdep.c
408 *-------------------------------------------------------------------------*/
410 extern String findMPathname Args((String,String,String));
411 extern String findPathname Args((String,String));
413 extern Int shellEsc Args((String));
414 extern Int getTerminalWidth Args((Void));
415 extern Void normalTerminal Args((Void));
416 extern Void noechoTerminal Args((Void));
417 extern Int readTerminalChar Args((Void));
418 extern Void gcStarted Args((Void));
419 extern Void gcScanning Args((Void));
420 extern Void gcRecovered Args((Int));
421 extern Void gcCStack Args((Void));
423 /*-------------------------------------------------------------------------*/
425 extern Type typeInt64;
426 extern Type typeWord;
427 extern Type typeFloat;
428 extern Type typePrimArray;
429 extern Type typePrimByteArray;
431 extern Type typePrimMutableArray;
432 extern Type typePrimMutableByteArray;
433 extern Type typeStable;
434 extern Type typeWeak;
436 extern Type typeForeign;
437 extern Type typeMVar;
438 extern Type typeThreadId;
439 extern Type typeException;
443 extern Void foreignImport Args((Cell,Pair,Cell,Cell));
444 extern List foreignImports; /* foreign import declarations */
445 extern Void implementForeignImport Args((Name));
446 extern Void foreignExport Args((Cell,Cell,Cell,Cell));
447 extern List foreignExports; /* foreign export declarations */
448 extern Void implementForeignExport Args((Name));
453 Int userArity Args((Name));
456 extern List deriveEq Args((Tycon));
457 extern List deriveOrd Args((Tycon));
458 extern List deriveEnum Args((Tycon));
459 extern List deriveIx Args((Tycon));
460 extern List deriveShow Args((Tycon));
461 extern List deriveRead Args((Cell));
462 extern List deriveBounded Args((Tycon));
463 extern List checkPrimDefn Args((Triple));
465 extern Bool typeMatches Args((Type,Type));
466 extern Void evalExp Args((Void));
467 extern Void linkControl Args((Int));
468 extern Void deriveControl Args((Int));
469 extern Void translateControl Args((Int));
470 extern Void codegen Args((Int));
471 extern Void machdep Args((Int));
473 extern Void linkPreludeNames(void);
475 extern Kind starToStar; /* Type -> Type */
476 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
477 extern Type typeOrdering;
479 extern Type conToTagType Args((Tycon));
480 extern Type tagToConType Args((Tycon));
482 #define BOGUS(k) (-9000000-(k))
484 extern Void putChr Args((Int));
485 extern Void putStr Args((String));
486 extern Void putInt Args((Int));
487 extern Void putPtr Args((Ptr));
489 extern Void unlexCharConst Args((Cell));
490 extern FILE *outputStream; /* current output stream */
491 extern Int outColumn; /* current output column number */
493 extern Void unlexStrConst Args((Text));
494 extern Void unlexVar Args((Text));
495 extern List offsetTyvarsIn Args((Type,List));
497 extern Void optimiseTopBinds Args((List));
498 extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
500 extern Void interface Args((Int));
502 extern List typeVarsIn Args((Cell,List,List));
504 extern Void getFileSize Args((String, Long *));
506 extern Void loadInterface Args((String,Long));
508 extern Void openGHCIface Args((Text));
509 extern Void loadSharedLib Args((String));
510 extern Void addGHCImports Args((Int,Text,List));
511 extern Void addGHCExports Args((Cell,List));
512 extern Void addGHCVar Args((Int,Text,Type));
513 extern Void addGHCSynonym Args((Int,Cell,List,Type));
514 extern Void addGHCDataDecl Args((Int,List,Cell,List,List));
515 extern Void addGHCNewType Args((Int,List,Cell,List,Cell));
516 extern Void addGHCClass Args((Int,List,Cell,List,List));
517 extern Void addGHCInstance Args((Int,List,Pair,Text));
518 extern Void finishInterfaces Args((Void));
520 extern Void hi_o_namesFromSrcName Args((String,String*,String* oName));
521 extern Void parseInterface Args((String,Long));
524 #define SMALL_INLINE_SIZE 9
527 // nasty hack, but seems an easy to convey the object name
528 // and size to openGHCIface
529 char nameObj[FILENAME_MAX+1];