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