[project @ 1999-03-09 14:51:03 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / connect.h
1 /* --------------------------------------------------------------------------
2  * Connections between components of the Hugs system
3  *
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.
8  *
9  * $RCSfile: connect.h,v $
10  * $Revision: 1.5 $
11  * $Date: 1999/03/09 14:51:05 $
12  * ------------------------------------------------------------------------*/
13
14 /* --------------------------------------------------------------------------
15  * Standard data:
16  * ------------------------------------------------------------------------*/
17
18 extern Bool   haskell98;                /* TRUE => Haskell 98 compatibility*/
19 extern Module modulePrelude;
20
21 /* --------------------------------------------------------------------------
22  * Primitive constructor functions 
23  * ------------------------------------------------------------------------*/
24
25 extern Name  nameFalse, nameTrue;
26 extern Name  nameNil,   nameCons;
27 extern Name  nameJust,  nameNothing;
28 extern Name  nameLeft,  nameRight;
29 extern Name  nameUnit;
30
31 extern Name  nameLT,      nameEQ;
32 extern Name  nameGT;
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;
43 #if NPLUSK
44 extern Name  namePmNpk,   namePmSub;    /* primitives for (n+k) patterns   */
45 #endif
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
77 #if EVAL_INSTANCES
78 extern Name  nameStrict,  nameSeq;      /* Members of class Eval           */
79 extern Name  nameIStrict, nameISeq;     /* ... and their implementations   */
80 #endif
81
82 extern Name  namePrint;                 /* printing primitive              */
83
84 #if    IO_MONAD
85 extern Type   typeProgIO;               /* For the IO monad, IO ()         */
86 extern Name   nameIORun;                /* IO monad executor               */
87 extern Name   namePutStr;               /* Prelude.putStr                  */
88 extern Name   nameUserErr;              /* primitives required for IOError */
89 extern Name   nameNameErr,  nameSearchErr;
90 #endif
91
92 #if IO_HANDLES
93 extern Name   nameWriteErr, nameIllegal;/* primitives required for IOError */
94 extern Name   nameEOFErr;
95 #endif
96
97 extern Text  textPrelude;
98 extern Text  textNum;                   /* used to process default decls   */
99 #if    NPLUSK
100 extern Text  textPlus;                  /* Used to recognise n+k patterns  */
101 #endif
102 #if TREX
103 extern Name  nameNoRec;                 /* The empty record                */
104 extern Type  typeNoRow;                 /* The empty row                   */
105 extern Type  typeRec;                   /* Record formation                */
106 extern Kind  extKind;                   /* Kind of extension, *->row->row  */
107 extern Name  nameRecExt;                /* Extend a record                 */
108 extern Name  nameRecBrk;                /* Break a record                  */
109 extern Name  nameAddEv;                 /* Addition of evidence values     */
110 extern Name  nameRecSel;                /* Select a record                 */
111 extern Name  nameRecShw;                /* Show a record                   */
112 extern Name  nameShowRecRow;            /* Used to output rows             */
113 extern Name  nameRecEq;                 /* Compare records                 */
114 extern Name  nameEqRecRow;              /* Used to compare rows            */
115 extern Name  nameInsFld;                /* Field insertion routine         */
116 #endif
117
118 extern String repeatStr;                /* Repeat last command string      */
119 extern String hugsEdit;                 /* String for editor command       */
120 extern String hugsPath;                 /* String for file search path     */
121 extern String projectPath;              /* String for project search path  */
122
123 extern Type  typeArrow;                 /* Builtin type constructors       */
124 extern Type  typeList;
125 extern Type  typeUnit;
126
127 #define fn(from,to)  ap(ap(typeArrow,from),to)  /* make type: from -> to   */
128
129 extern List  stdDefaults;               /* List of standard default types  */
130
131 extern Class classEq;                   /* `standard' classes              */
132 extern Class classOrd;
133 extern Class classShow;
134 extern Class classRead;
135 extern Class classIx;
136 extern Class classEnum;
137 #if EVAL_INSTANCES
138 extern Class classEval;
139 #endif
140 extern Class classBounded;
141
142 extern Class classReal;                 /* `numeric' classes               */
143 extern Class classIntegral;
144 extern Class classRealFrac;
145 extern Class classRealFloat;
146 extern Class classFractional;
147 extern Class classFloating;
148 extern Class classNum;
149
150 extern Cell  *CStackBase;               /* pointer to base of C stack      */
151
152 extern List  tyconDefns;                /* list of type constructor defns  */
153 extern List  typeInDefns;               /* list of synonym restrictions    */
154 extern List  valDefns;                  /* list of value definitions       */
155 extern List  classDefns;                /* list of class definitions       */
156 extern List  instDefns;                 /* list of instance definitions    */
157 extern List  selDefns;                  /* list of selector lists          */
158 extern List  genDefns;                  /* list of generated defns         */
159 extern List  primDefns;                 /* list of primitive definitions   */
160 extern List  unqualImports;             /* unqualified import list         */
161 extern List  defaultDefns;              /* default definitions (if any)    */
162 extern Int   defaultLine;               /* line in which default defs occur*/
163 extern List  evalDefaults;              /* defaults for evaluator          */
164 extern Cell  inputExpr;                 /* evaluator input expression      */
165 extern Addr  inputCode;                 /* Code for compiled input expr    */
166
167 extern Int   whnfArgs;                  /* number of args of term in whnf  */
168 extern Cell  whnfHead;                  /* head of term in whnf            */
169 extern Int   whnfInt;                   /* integer value of term in whnf   */
170 extern Float whnfFloat;                 /* float value of term in whnf     */
171 /*ToDo?? extern Long  numReductions;*/             /* number of reductions used       */
172 extern Long  numCells;                  /* number of cells allocated       */
173 extern Int   numGcs;                    /* number of garbage collections   */
174 extern Bool  broken;                    /* indicates interrupt received    */
175 extern Bool  preludeLoaded;             /* TRUE => prelude has been loaded */
176
177 extern Bool  gcMessages;                /* TRUE => print GC messages       */
178 extern Bool  literateScripts;           /* TRUE => default lit scripts     */
179 extern Bool  literateErrors;            /* TRUE => report errs in lit scrs */
180 /*ToDo?? extern Bool  failOnError;*/              /* TRUE => error produces immediate*/
181                                         /*         termination             */
182
183 extern Int   cutoff;                    /* Constraint Cutoff depth         */
184
185 #if USE_PREPROCESSOR
186 extern String preprocessor;             /* preprocessor command            */
187 #endif
188
189 #if DEBUG_CODE
190 extern Bool  debugCode;                 /* TRUE => print G-code to screen  */
191 #endif
192 extern Bool  kindExpert;                /* TRUE => display kind errors in  */
193                                         /*         full detail             */
194 extern Bool  allowOverlap;              /* TRUE => allow overlapping insts */
195
196 /* --------------------------------------------------------------------------
197  * Function prototypes etc...
198  * ------------------------------------------------------------------------*/
199
200 extern Void everybody Args((Int));
201
202 #define RESET   1               /* reset subsystem                         */
203 #define MARK    2               /* mark parts of graph in use by subsystem */
204 #define INSTALL 3               /* install subsystem (executed once only)  */
205 #define EXIT    4               /* Take action immediately before exit()   */
206 #define BREAK   5               /* Take action after program break         */
207
208 typedef long   Target;
209 extern  Void   setGoal          Args((String, Target));
210 extern  Void   soFar            Args((Target));
211 extern  Void   done             Args((Void));
212 extern  String fromEnv          Args((String,String));
213 extern  Bool   chase            Args((List));
214
215 extern  Void   storage          Args((Int));
216
217 extern  Void   input            Args((Int));
218 extern  Void   consoleInput     Args((String));
219 extern  Void   projInput        Args((String));
220 extern  Void   stringInput      Args((String));
221 extern  Void   parseScript      Args((String,Long));
222 extern  Void   parseExp         Args((Void));
223 extern  String readFilename     Args((Void));
224 extern  String readLine         Args((Void));
225 extern  Syntax defaultSyntax    Args((Text));
226 extern  Syntax syntaxOf         Args((Name));
227 extern  String unlexChar        Args((Char,Char));
228 extern  Void   printString      Args((String));
229
230 extern  Void   substitution     Args((Int));
231
232 extern  Void   staticAnalysis   Args((Int));
233 #if IGNORE_MODULES
234 #define startModule(m)       doNothing()
235 #define setExportList(l)     doNothing()
236 #define setExports(l)        doNothing()
237 #define addQualImport(m,as)  doNothing()
238 #define addUnqualImport(m,l) doNothing()
239 #else
240 extern  Void   startModule      Args((Cell));
241 extern  Void   setExportList    Args((List));
242 extern  Void   setExports       Args((List));
243 extern  Void   addQualImport    Args((Text,Text));
244 extern  Void   addUnqualImport  Args((Text,List));
245 #endif
246 extern  Void   tyconDefn        Args((Int,Cell,Cell,Cell));
247 extern  Void   setTypeIns       Args((List));
248 extern  Void   clearTypeIns     Args((Void));
249 extern  Type   fullExpand       Args((Type));
250 extern  Bool   isAmbiguous      Args((Type));
251 extern  Void   ambigError       Args((Int,String,Cell,Type));
252 extern  Void   classDefn        Args((Int,Cell,Cell));
253 extern  Void   instDefn         Args((Int,Cell,Cell));
254 extern  Void   addTupInst       Args((Class,Int));
255 #if EVAL_INSTANCES
256 extern  Void   addEvalInst      Args((Int,Cell,Int,List));
257 #endif
258 #if TREX
259 extern  Inst   addRecShowInst   Args((Class,Ext));
260 extern  Inst   addRecEqInst     Args((Class,Ext));
261 #endif
262 extern  Void   primDefn         Args((Cell,List,Cell));
263 extern  Void   defaultDefn      Args((Int,List));
264 extern  Void   checkExp         Args((Void));
265 extern  Void   checkDefns       Args((Void));
266 extern  Bool   h98Pred          Args((Bool,Cell));
267 extern  Cell   h98Context       Args((Bool,List));
268 extern  Void   h98CheckCtxt     Args((Int,String,Bool,List,Inst));
269 extern  Void   h98CheckType     Args((Int,String,Cell,Type));
270 extern  Void   h98DoesntSupport Args((Int,String));
271
272 extern  Void   typeChecker      Args((Int));
273 extern  Type   typeCheckExp     Args((Bool));
274 extern  Void   typeCheckDefns   Args((Void));
275 extern  Cell   provePred        Args((Kinds,List,Cell));
276 extern  List   simpleContext    Args((List,Int));
277 extern  Cell   rhsExpr          Args((Cell));
278 extern  Int    rhsLine          Args((Cell));
279 extern  Bool   isProgType       Args((List,Type));
280 extern  Cell   superEvid        Args((Cell,Class,Class));
281 extern  Void   linkPreludeTC    Args((Void));
282 extern  Void   linkPreludeCM    Args((Void));
283
284 extern  Void   compiler         Args((Int));
285 extern  Void   compileDefns     Args((Void));
286 extern  Void   compileExp       Args((Void));
287 extern  Bool   failFree         Args((Cell));
288 extern  Int    discrArity       Args((Cell));
289
290 extern  Addr   codeGen          Args((Name,Int,Cell));
291 extern  Void   implementCfun    Args((Name,List));
292 #if TREX
293 extern  Name   implementRecShw  Args((Text,Cell));
294 extern  Name   implementRecEq   Args((Text,Cell));
295 #endif
296 extern  Void   addCfunTable     Args((Tycon));
297 extern  Name   succCfun         Args((Name));
298 extern  Name   nextCfun         Args((Name,Name));
299 extern  Name   cfunByNum        Args((Name,Int));
300 extern  Void   unwind           Args((Cell));
301 extern  Void   run              Args((Addr,StackPtr));
302
303 extern  Void   eval             Args((Cell));
304 extern  Cell   evalWithNoError  Args((Cell));
305 extern  Void   evalFails        Args((StackPtr));
306
307 #if BYTECODE_PRIMS
308 extern Int     IntAt            Args((Addr));
309 #if !BREAK_FLOATS
310 extern Float   FloatAt          Args((Addr));
311 #endif
312 extern Cell    CellAt           Args((Addr));
313 extern Text    TextAt           Args((Addr));
314 extern Addr    AddrAt           Args((Addr));
315 extern Int     InstrAt          Args((Addr));
316 #endif /* BYTECODE_PRIMS */
317
318 extern  Void   abandon          Args((String,Cell));
319 extern  Void   outputString     Args((FILE *));
320 extern  Void   dialogue         Args((Cell));
321 #define consChar(c) ap(nameCons,mkChar(c))
322
323 #if BIGNUMS
324 extern  Bignum bigInt           Args((Int));
325 extern  Bignum bigDouble        Args((double));
326 extern  Bignum bigNeg           Args((Bignum));
327 extern  Cell   bigToInt         Args((Bignum));
328 extern  Cell   bigToFloat       Args((Bignum));
329 extern  Bignum bigStr           Args((String));
330 extern  Cell   bigOut           Args((Bignum,Cell,Bool));
331 extern  Bignum bigShift         Args((Bignum,Int,Int));
332 extern  Int    bigCmp           Args((Bignum,Bignum));
333 #endif
334 #if IO_MONAD
335 extern Void   setHugsArgs       Args((Int,String[]));
336 #endif
337
338 #if PROFILING
339 extern  String timeString       Args((Void));
340 #endif
341
342 extern  Int    shellEsc         Args((String));
343 extern  Int    getTerminalWidth Args((Void));
344 extern  Void   normalTerminal   Args((Void));
345 extern  Void   noechoTerminal   Args((Void));
346 extern  Int    readTerminalChar Args((Void));
347 extern  Void   gcStarted        Args((Void));
348 extern  Void   gcScanning       Args((Void));
349 extern  Void   gcRecovered      Args((Int));
350 extern  Void   gcCStack         Args((Void));
351 extern  Void   needPrims        Args((Int)); 
352
353 extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds );
354 #define aVar            mkOffset(0)     /* Simple skeleton for type var    */
355
356 /*-------------------------------------------------------------------------*/
357
358 /*---------------------------------------------------------------------------
359  * Interrupting execution (signals, allowBreak):
360  *-------------------------------------------------------------------------*/
361
362 extern Bool breakOn      Args((Bool));
363
364 extern Bool  broken;                    /* indicates interrupt received    */
365
366 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
367 # define SIGBREAK 21
368 #endif
369
370 /* allowBreak: call to allow user to interrupt computation
371  * ctrlbrk:    set control break handler
372  */
373
374 #if HUGS_FOR_WINDOWS
375 #  define ctrlbrk(bh) 
376 #  define allowBreak()  kbhit()
377 #else /* !HUGS_FOR_WINDOWS */
378 #  define ctrlbrk(bh)   signal(SIGINT,bh); signal(SIGBREAK,bh)
379 #  define allowBreak()  if (broken) { broken=FALSE; sigRaise(breakHandler); }
380 #endif /* !HUGS_FOR_WINDOWS */
381
382 /*---------------------------------------------------------------------------
383  * Environment variables and the registry
384  *-------------------------------------------------------------------------*/
385
386 /* On Win32 we can use the registry to supplement info in environment 
387  * variables.
388  */
389 #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__)
390
391 #ifdef USE_REGISTRY
392 Bool    writeRegString Args((String var, String val));
393 String  readRegString  Args((String var, String def));
394 Int     readRegInt     Args((String var, Int def));
395 Bool    writeRegInt    Args((String var, Int val));
396 #endif
397
398 /*---------------------------------------------------------------------------
399  * File operations:
400  *-------------------------------------------------------------------------*/
401
402 #if HAVE_UNISTD_H
403 # include <sys/types.h>
404 # include <unistd.h>
405 #elif !HUGS_FOR_WINDOWS
406 extern int      chdir      Args((const char*));
407 #endif
408
409 #if HAVE_STDLIB_H
410 # include <stdlib.h>
411 #else
412 extern int      system     Args((const char *));
413 extern double   atof       Args((const char *));
414 extern void     exit       Args((int));
415 #endif
416
417 #ifndef FILENAME_MAX       /* should already be defined in an ANSI compiler*/
418 #define FILENAME_MAX 256
419 #else
420 #if     FILENAME_MAX < 256
421 #undef  FILENAME_MAX
422 #define FILENAME_MAX 256
423 #endif
424 #endif
425
426 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
427 #define DOS_FILENAMES              HAVE_DOS_H
428 /* ToDo: can we replace this with a feature test? */
429 #define MAC_FILENAMES              SYMANTEC_C
430
431 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
432
433 #if CASE_INSENSITIVE_FILENAMES
434 # if HAVE_STRCASECMP
435 #  define filenamecmp(s1,s2) strcasecmp(s1,s2)
436 # elif HAVE__STRICMP
437 #  define filenamecmp(s1,s2) _stricmp(s1,s2)
438 # elif HAVE_STRICMP
439 #  define filenamecmp(s1,s2) stricmp(s1,s2)
440 # elif HAVE_STRCMPI
441 #  define filenamecmp(s1,s2) strcmpi(s1,s2)
442 # endif
443 #else
444 # define filenamecmp(s1,s2) strcmp(s1,s2)
445 #endif
446
447 /*---------------------------------------------------------------------------
448  * Pipe-related operations:
449  *
450  * On Windows, many standard Unix names acquire a leading underscore.
451  * Irritating, but easy to work around.
452  *-------------------------------------------------------------------------*/
453
454 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
455 #define popen(x,y) _popen(x,y)
456 #endif
457 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
458 #define pclose(x) _pclose(x)
459 #endif
460
461 /*---------------------------------------------------------------------------
462  * Bit manipulation:
463  *-------------------------------------------------------------------------*/
464
465 #define bitArraySize(n)    ((n)/bitsPerWord + 1)
466 #define placeInSet(n)      ((-(n)-1)>>wordShift)
467 #define maskInSet(n)       (1<<((-(n)-1)&wordMask))
468
469 /*---------------------------------------------------------------------------
470  * Function prototypes for code in machdep.c
471  *-------------------------------------------------------------------------*/
472
473 extern  String findMPathname    Args((String,String,String));
474 extern  String findPathname     Args((String,String));
475
476 extern  Int    shellEsc         Args((String));
477 extern  Int    getTerminalWidth Args((Void));
478 extern  Void   normalTerminal   Args((Void));
479 extern  Void   noechoTerminal   Args((Void));
480 extern  Int    readTerminalChar Args((Void));
481 extern  Void   gcStarted        Args((Void));
482 extern  Void   gcScanning       Args((Void));
483 extern  Void   gcRecovered      Args((Int));
484 extern  Void   gcCStack         Args((Void));
485
486 /*-------------------------------------------------------------------------*/
487
488 extern Type typeInt64;
489 extern Type typeWord;
490 extern Type typeFloat;
491 extern Type typePrimArray;
492 extern Type typePrimByteArray;
493 extern Type typeRef;
494 extern Type typePrimMutableArray;
495 extern Type typePrimMutableByteArray;
496 extern Type typeStable;
497 extern Type typeWeak;
498 extern Type typeIO;
499 extern Type typeForeign;
500 extern Type typeMVar;
501 extern Type typeThreadId;
502 extern Type typeException;
503 extern Type typeIO;
504 extern Type typeST;
505
506 extern  Void   foreignImport    Args((Cell,Pair,Cell,Cell));
507 extern List  foreignImports;            /* foreign import declarations     */
508 extern  Void   implementForeignImport Args((Name));
509 extern  Void   foreignExport   Args((Cell,Cell,Cell,Cell));
510 extern List  foreignExports;            /* foreign export declarations     */
511 extern  Void   implementForeignExport Args((Name));
512
513 extern List diVars;
514 extern Int  diNum;
515
516 Int     userArity           Args((Name));
517
518
519 extern List    deriveEq            Args((Tycon));
520 extern List    deriveOrd           Args((Tycon));
521 extern List    deriveEnum          Args((Tycon));
522 extern List    deriveIx            Args((Tycon));
523 extern List    deriveShow          Args((Tycon));
524 extern List    deriveRead          Args((Cell));
525 extern List    deriveBounded       Args((Tycon));
526 extern List    checkPrimDefn       Args((Triple));
527
528 extern Bool  typeMatches        Args((Type,Type));
529 extern  Void   evalExp           Args((Void));
530 extern  Void   linkControl      Args((Int));
531 extern  Void   deriveControl    Args((Int));
532 extern  Void   translateControl Args((Int));
533 extern  Void   codegen          Args((Int));
534 extern  Void   machdep          Args((Int));
535
536 extern Void linkPreludeNames(void);
537
538 extern  Kind  starToStar;                /* Type -> Type                    */
539 extern Type  boundPair;                 /* (mkOffset(0),mkOffset(0))       */
540 extern        Type typeOrdering;
541
542 extern  Type   conToTagType     Args((Tycon));
543 extern  Type   tagToConType     Args((Tycon));
544
545 #define BOGUS(k) (-9000000-(k))
546
547 extern Void putChr  Args((Int));
548 extern Void putStr  Args((String));
549 extern Void putInt  Args((Int));
550 extern Void putPtr  Args((Ptr));
551
552 extern Void unlexCharConst Args((Cell));
553 extern FILE *outputStream;             /* current output stream            */
554 extern Int  outColumn;                 /* current output column number     */
555
556 extern Void unlexStrConst  Args((Text));
557 extern Void unlexVar       Args((Text));
558 extern List offsetTyvarsIn          Args((Type,List));
559
560 extern List cfunSfuns;                  /* List of (Cfun,[SelectorVar])    */