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/03/01 14:46:43 $
12 * ------------------------------------------------------------------------*/
14 /* --------------------------------------------------------------------------
16 * ------------------------------------------------------------------------*/
18 extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
19 extern Module modulePrelude;
20 //extern Module modulePreludeHugs;
22 /* --------------------------------------------------------------------------
23 * Primitive constructor functions
24 * ------------------------------------------------------------------------*/
26 extern Name nameFalse, nameTrue;
27 extern Name nameNil, nameCons;
28 extern Name nameJust, nameNothing;
29 extern Name nameLeft, nameRight;
32 extern Name nameLT, nameEQ;
34 extern Name nameFst, nameSnd; /* standard combinators */
35 extern Name nameId, nameOtherwise;
36 extern Name nameNegate, nameFlip; /* primitives reqd for parsing */
37 extern Name nameFrom, nameFromThen;
38 extern Name nameFromTo, nameFromThenTo;
39 extern Name nameFatbar, nameFail; /* primitives reqd for translation */
40 extern Name nameIf, nameSel;
41 extern Name nameCompAux;
42 extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
43 extern Name namePmInteger;
45 extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */
47 extern Name nameError; /* For runtime error messages */
48 extern Name nameUndefined; /* A generic undefined value */
49 extern Name nameBlackHole; /* For GC-detected black hole */
50 extern Name nameInd; /* For dict indirection */
51 extern Name nameAnd, nameOr; /* For optimisation of && and || */
52 extern Name nameFromInt, nameFromDouble;/*coercion of numerics */
53 extern Name nameFromInteger;
54 extern Name nameEq, nameCompare; /* names used for deriving */
55 extern Name nameMinBnd, nameMaxBnd;
56 extern Name nameIndex, nameInRange;
57 extern Name nameRange;
58 extern Name nameLe, nameGt;
59 extern Name nameShowsPrec, nameReadsPrec;
60 extern Name nameMult, namePlus;
61 extern Name nameConCmp, nameEnRange;
62 extern Name nameEnIndex, nameEnInRng;
63 extern Name nameEnToEn, nameEnFrEn;
64 extern Name nameEnFrom, nameEnFrTh;
65 extern Name nameEnFrTo;
66 extern Name nameComp, nameApp; /* composition and append */
67 extern Name nameShowField; /* display single field */
68 extern Name nameShowParen; /* wrap with parens */
69 extern Name nameReadField; /* read single field */
70 extern Name nameReadParen; /* unwrap from parens */
71 extern Name nameLex; /* lexer */
72 extern Name nameRangeSize; /* calculate size of index range */
73 extern Class classMonad; /* Monads */
74 extern Name nameReturn, nameBind; /* for translating monad comps */
75 extern Name nameMFail;
76 extern Name nameListMonad; /* builder function for List Monad */
79 extern Name nameStrict, nameSeq; /* Members of class Eval */
80 extern Name nameIStrict, nameISeq; /* ... and their implementations */
83 extern Name namePrint; /* printing primitive */
86 extern Type typeProgIO; /* For the IO monad, IO () */
87 extern Name nameIORun; /* IO monad executor */
88 extern Name namePutStr; /* Prelude.putStr */
89 extern Name nameUserErr; /* primitives required for IOError */
90 extern Name nameNameErr, nameSearchErr;
94 extern Name nameWriteErr, nameIllegal;/* primitives required for IOError */
95 extern Name nameEOFErr;
98 extern Text textPrelude;
99 extern Text textNum; /* used to process default decls */
101 extern Text textPlus; /* Used to recognise n+k patterns */
104 extern Name nameNoRec; /* The empty record */
105 extern Type typeNoRow; /* The empty row */
106 extern Type typeRec; /* Record formation */
107 extern Kind extKind; /* Kind of extension, *->row->row */
108 extern Name nameRecExt; /* Extend a record */
109 extern Name nameRecBrk; /* Break a record */
110 extern Name nameAddEv; /* Addition of evidence values */
111 extern Name nameRecSel; /* Select a record */
112 extern Name nameRecShw; /* Show a record */
113 extern Name nameShowRecRow; /* Used to output rows */
114 extern Name nameRecEq; /* Compare records */
115 extern Name nameEqRecRow; /* Used to compare rows */
116 extern Name nameInsFld; /* Field insertion routine */
119 extern String repeatStr; /* Repeat last command string */
120 extern String hugsEdit; /* String for editor command */
121 extern String hugsPath; /* String for file search path */
122 extern String projectPath; /* String for project search path */
124 extern Type typeArrow; /* Builtin type constructors */
125 extern Type typeList;
126 extern Type typeUnit;
128 #define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */
130 extern List stdDefaults; /* List of standard default types */
132 extern Class classEq; /* `standard' classes */
133 extern Class classOrd;
134 extern Class classShow;
135 extern Class classRead;
136 extern Class classIx;
137 extern Class classEnum;
139 extern Class classEval;
141 extern Class classBounded;
143 extern Class classReal; /* `numeric' classes */
144 extern Class classIntegral;
145 extern Class classRealFrac;
146 extern Class classRealFloat;
147 extern Class classFractional;
148 extern Class classFloating;
149 extern Class classNum;
151 extern Cell *CStackBase; /* pointer to base of C stack */
153 extern List tyconDefns; /* list of type constructor defns */
154 extern List typeInDefns; /* list of synonym restrictions */
155 extern List valDefns; /* list of value definitions */
156 extern List classDefns; /* list of class definitions */
157 extern List instDefns; /* list of instance definitions */
158 extern List selDefns; /* list of selector lists */
159 extern List genDefns; /* list of generated defns */
160 extern List primDefns; /* list of primitive definitions */
161 extern List unqualImports; /* unqualified import list */
162 extern List defaultDefns; /* default definitions (if any) */
163 extern Int defaultLine; /* line in which default defs occur*/
164 extern List evalDefaults; /* defaults for evaluator */
165 extern Cell inputExpr; /* evaluator input expression */
166 extern Addr inputCode; /* Code for compiled input expr */
168 extern Int whnfArgs; /* number of args of term in whnf */
169 extern Cell whnfHead; /* head of term in whnf */
170 extern Int whnfInt; /* integer value of term in whnf */
171 extern Float whnfFloat; /* float value of term in whnf */
172 /*ToDo?? extern Long numReductions;*/ /* number of reductions used */
173 extern Long numCells; /* number of cells allocated */
174 extern Int numGcs; /* number of garbage collections */
175 extern Bool broken; /* indicates interrupt received */
176 /*ToDo?? extern Bool preludeLoaded;*/ /* TRUE => prelude has been loaded */
178 extern Bool gcMessages; /* TRUE => print GC messages */
179 extern Bool literateScripts; /* TRUE => default lit scripts */
180 extern Bool literateErrors; /* TRUE => report errs in lit scrs */
181 /*ToDo?? extern Bool failOnError;*/ /* TRUE => error produces immediate*/
184 extern Int cutoff; /* Constraint Cutoff depth */
187 extern String preprocessor; /* preprocessor command */
191 extern Bool debugCode; /* TRUE => print G-code to screen */
193 extern Bool kindExpert; /* TRUE => display kind errors in */
195 extern Bool allowOverlap; /* TRUE => allow overlapping insts */
197 /* --------------------------------------------------------------------------
198 * Function prototypes etc...
199 * ------------------------------------------------------------------------*/
201 extern Void everybody Args((Int));
203 #define RESET 1 /* reset subsystem */
204 #define MARK 2 /* mark parts of graph in use by subsystem */
205 #define INSTALL 3 /* install subsystem (executed once only) */
206 #define EXIT 4 /* Take action immediately before exit() */
207 #define BREAK 5 /* Take action after program break */
210 extern Void setGoal Args((String, Target));
211 extern Void soFar Args((Target));
212 extern Void done Args((Void));
213 extern String fromEnv Args((String,String));
214 extern Bool chase Args((List));
216 extern Void storage Args((Int));
218 extern Void input Args((Int));
219 extern Void consoleInput Args((String));
220 extern Void projInput Args((String));
221 extern Void stringInput Args((String));
222 extern Void parseScript Args((String,Long));
223 extern Void parseExp Args((Void));
224 extern String readFilename Args((Void));
225 extern String readLine Args((Void));
226 extern Syntax defaultSyntax Args((Text));
227 extern Syntax syntaxOf Args((Name));
228 extern String unlexChar Args((Char,Char));
229 extern Void printString Args((String));
231 extern Void substitution Args((Int));
233 extern Void staticAnalysis Args((Int));
235 #define startModule(m) doNothing()
236 #define setExportList(l) doNothing()
237 #define setExports(l) doNothing()
238 #define addQualImport(m,as) doNothing()
239 #define addUnqualImport(m,l) doNothing()
241 extern Void startModule Args((Cell));
242 extern Void setExportList Args((List));
243 extern Void setExports Args((List));
244 extern Void addQualImport Args((Text,Text));
245 extern Void addUnqualImport Args((Text,List));
247 extern Void tyconDefn Args((Int,Cell,Cell,Cell));
248 extern Void setTypeIns Args((List));
249 extern Void clearTypeIns Args((Void));
250 extern Type fullExpand Args((Type));
251 extern Bool isAmbiguous Args((Type));
252 extern Void ambigError Args((Int,String,Cell,Type));
253 extern Void classDefn Args((Int,Cell,Cell));
254 extern Void instDefn Args((Int,Cell,Cell));
255 extern Void addTupInst Args((Class,Int));
257 extern Void addEvalInst Args((Int,Cell,Int,List));
260 extern Inst addRecShowInst Args((Class,Ext));
261 extern Inst addRecEqInst Args((Class,Ext));
263 extern Void primDefn Args((Cell,List,Cell));
264 extern Void defaultDefn Args((Int,List));
265 extern Void checkExp Args((Void));
266 extern Void checkDefns Args((Void));
267 extern Bool h98Pred Args((Bool,Cell));
268 extern Cell h98Context Args((Bool,List));
269 extern Void h98CheckCtxt Args((Int,String,Bool,List,Inst));
270 extern Void h98CheckType Args((Int,String,Cell,Type));
271 extern Void h98DoesntSupport Args((Int,String));
273 extern Void typeChecker Args((Int));
274 extern Type typeCheckExp Args((Bool));
275 extern Void typeCheckDefns Args((Void));
276 extern Cell provePred Args((Kinds,List,Cell));
277 extern List simpleContext Args((List,Int));
278 extern Cell rhsExpr Args((Cell));
279 extern Int rhsLine Args((Cell));
280 extern Bool isProgType Args((List,Type));
281 extern Cell superEvid Args((Cell,Class,Class));
282 extern Void linkPreludeTC Args((Void));
283 extern Void linkPreludeCM Args((Void));
285 extern Void compiler Args((Int));
286 extern Void compileDefns Args((Void));
287 extern Void compileExp Args((Void));
288 extern Bool failFree Args((Cell));
289 extern Int discrArity Args((Cell));
291 extern Addr codeGen Args((Name,Int,Cell));
292 extern Void implementCfun Args((Name,List));
294 extern Name implementRecShw Args((Text,Cell));
295 extern Name implementRecEq Args((Text,Cell));
297 extern Void addCfunTable Args((Tycon));
298 extern Name succCfun Args((Name));
299 extern Name nextCfun Args((Name,Name));
300 extern Name cfunByNum Args((Name,Int));
301 extern Void unwind Args((Cell));
302 extern Void run Args((Addr,StackPtr));
304 extern Void eval Args((Cell));
305 extern Cell evalWithNoError Args((Cell));
306 extern Void evalFails Args((StackPtr));
309 extern Int IntAt Args((Addr));
311 extern Float FloatAt Args((Addr));
313 extern Cell CellAt Args((Addr));
314 extern Text TextAt Args((Addr));
315 extern Addr AddrAt Args((Addr));
316 extern Int InstrAt Args((Addr));
317 #endif /* BYTECODE_PRIMS */
319 extern Void abandon Args((String,Cell));
320 extern Void outputString Args((FILE *));
321 extern Void dialogue Args((Cell));
322 #define consChar(c) ap(nameCons,mkChar(c))
325 extern Bignum bigInt Args((Int));
326 extern Bignum bigDouble Args((double));
327 extern Bignum bigNeg Args((Bignum));
328 extern Cell bigToInt Args((Bignum));
329 extern Cell bigToFloat Args((Bignum));
330 extern Bignum bigStr Args((String));
331 extern Cell bigOut Args((Bignum,Cell,Bool));
332 extern Bignum bigShift Args((Bignum,Int,Int));
333 extern Int bigCmp Args((Bignum,Bignum));
336 extern Void setHugsArgs Args((Int,String[]));
340 extern String timeString Args((Void));
343 extern Int shellEsc Args((String));
344 extern Int getTerminalWidth Args((Void));
345 extern Void normalTerminal Args((Void));
346 extern Void noechoTerminal Args((Void));
347 extern Int readTerminalChar Args((Void));
348 extern Void gcStarted Args((Void));
349 extern Void gcScanning Args((Void));
350 extern Void gcRecovered Args((Int));
351 extern Void gcCStack Args((Void));
352 extern Void needPrims Args((Int));
354 extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds );
355 #define aVar mkOffset(0) /* Simple skeleton for type var */
357 /*-------------------------------------------------------------------------*/
359 /*---------------------------------------------------------------------------
360 * Interrupting execution (signals, allowBreak):
361 *-------------------------------------------------------------------------*/
363 extern Bool breakOn Args((Bool));
365 extern Bool broken; /* indicates interrupt received */
367 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
371 /* allowBreak: call to allow user to interrupt computation
372 * ctrlbrk: set control break handler
377 # define allowBreak() kbhit()
378 #else /* !HUGS_FOR_WINDOWS */
379 # define ctrlbrk(bh) signal(SIGINT,bh); signal(SIGBREAK,bh)
380 # define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
381 #endif /* !HUGS_FOR_WINDOWS */
383 /*---------------------------------------------------------------------------
384 * Environment variables and the registry
385 *-------------------------------------------------------------------------*/
387 /* On Win32 we can use the registry to supplement info in environment
390 #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__)
393 Bool writeRegString Args((String var, String val));
394 String readRegString Args((String var, String def));
395 Int readRegInt Args((String var, Int def));
396 Bool writeRegInt Args((String var, Int val));
399 /*---------------------------------------------------------------------------
401 *-------------------------------------------------------------------------*/
404 # include <sys/types.h>
406 #elif !HUGS_FOR_WINDOWS
407 extern int chdir Args((const char*));
413 extern int system Args((const char *));
414 extern double atof Args((const char *));
415 extern void exit Args((int));
418 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
419 #define FILENAME_MAX 256
421 #if FILENAME_MAX < 256
423 #define FILENAME_MAX 256
427 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
428 #define DOS_FILENAMES HAVE_DOS_H
429 /* ToDo: can we replace this with a feature test? */
430 #define MAC_FILENAMES SYMANTEC_C
432 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
434 #if CASE_INSENSITIVE_FILENAMES
436 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
438 # define filenamecmp(s1,s2) _stricmp(s1,s2)
440 # define filenamecmp(s1,s2) stricmp(s1,s2)
442 # define filenamecmp(s1,s2) strcmpi(s1,s2)
445 # define filenamecmp(s1,s2) strcmp(s1,s2)
448 /*---------------------------------------------------------------------------
449 * Pipe-related operations:
451 * On Windows, many standard Unix names acquire a leading underscore.
452 * Irritating, but easy to work around.
453 *-------------------------------------------------------------------------*/
455 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
456 #define popen(x,y) _popen(x,y)
458 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
459 #define pclose(x) _pclose(x)
462 /*---------------------------------------------------------------------------
464 *-------------------------------------------------------------------------*/
466 #define bitArraySize(n) ((n)/bitsPerWord + 1)
467 #define placeInSet(n) ((-(n)-1)>>wordShift)
468 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
470 /*---------------------------------------------------------------------------
471 * Function prototypes for code in machdep.c
472 *-------------------------------------------------------------------------*/
474 extern String findMPathname Args((String,String,String));
475 extern String findPathname Args((String,String));
477 extern Int shellEsc Args((String));
478 extern Int getTerminalWidth Args((Void));
479 extern Void normalTerminal Args((Void));
480 extern Void noechoTerminal Args((Void));
481 extern Int readTerminalChar Args((Void));
482 extern Void gcStarted Args((Void));
483 extern Void gcScanning Args((Void));
484 extern Void gcRecovered Args((Int));
485 extern Void gcCStack Args((Void));
487 /*-------------------------------------------------------------------------*/
489 extern Type typeInt64;
490 extern Type typeWord;
491 extern Type typeFloat;
492 extern Type typePrimArray;
493 extern Type typePrimByteArray;
495 extern Type typePrimMutableArray;
496 extern Type typePrimMutableByteArray;
497 extern Type typeStable;
498 extern Type typeWeak;
500 extern Type typeForeign;
501 extern Type typeMVar;
502 extern Type typeThreadId;
503 extern Type typeException;
507 extern Void foreignImport Args((Cell,Pair,Cell,Cell));
508 extern List foreignImports; /* foreign import declarations */
509 extern Void implementForeignImport Args((Name));
510 extern Void foreignExport Args((Cell,Cell,Cell,Cell));
511 extern List foreignExports; /* foreign export declarations */
512 extern Void implementForeignExport Args((Name));
517 Int userArity Args((Name));
520 extern List deriveEq Args((Tycon));
521 extern List deriveOrd Args((Tycon));
522 extern List deriveEnum Args((Tycon));
523 extern List deriveIx Args((Tycon));
524 extern List deriveShow Args((Tycon));
525 extern List deriveRead Args((Cell));
526 extern List deriveBounded Args((Tycon));
527 extern List checkPrimDefn Args((Triple));
529 extern Bool typeMatches Args((Type,Type));
530 extern Void evalExp Args((Void));
531 extern Void linkControl Args((Int));
532 extern Void deriveControl Args((Int));
533 extern Void translateControl Args((Int));
534 extern Void codegen Args((Int));
535 extern Void machdep Args((Int));
537 extern Void linkPreludeNames(void);
539 extern Kind starToStar; /* Type -> Type */
540 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
541 extern Type typeOrdering;
543 extern Type conToTagType Args((Tycon));
544 extern Type tagToConType Args((Tycon));
546 #define BOGUS(k) (-9000000-(k))
548 extern Void putChr Args((Int));
549 extern Void putStr Args((String));
550 extern Void putInt Args((Int));
551 extern Void putPtr Args((Ptr));
553 extern Void unlexCharConst Args((Cell));
554 extern FILE *outputStream; /* current output stream */
555 extern Int outColumn; /* current output column number */
557 extern Void unlexStrConst Args((Text));
558 extern Void unlexVar Args((Text));
559 extern List offsetTyvarsIn Args((Type,List));
561 extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */