2 /* --------------------------------------------------------------------------
3 * Connections between components of the Hugs system
5 * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
6 * Yale Haskell Group, and the Oregon Graduate Institute of Science and
7 * Technology, 1994-1999, All rights reserved. It is distributed as
8 * free software under the license in the file "License", which is
9 * included in the distribution.
11 * $RCSfile: connect.h,v $
13 * $Date: 2000/04/10 09:40:03 $
14 * ------------------------------------------------------------------------*/
16 /* --------------------------------------------------------------------------
17 * Connections to Prelude entities:
18 * Texts, Names, Instances, Classes, Types, Kinds and Modules
19 * ------------------------------------------------------------------------*/
21 extern Text textPrelPrim;
22 extern Text textPrelude;
23 extern Text textNum; /* used to process default decls */
24 extern Text textCcall; /* used to process foreign import */
25 extern Text textStdcall; /* ... and foreign export */
26 extern Text textPlus; /* Used to recognise n+k patterns */
29 extern Name nameFalse, nameTrue;
30 extern Name nameNil, nameCons;
31 extern Name nameJust, nameNothing;
32 extern Name nameLeft, nameRight;
34 extern Name nameLT, nameEQ;
36 extern Name nameFst, nameSnd; /* standard combinators */
37 extern Name nameId, nameOtherwise;
38 extern Name nameNegate, nameFlip; /* primitives reqd for parsing */
39 extern Name nameFrom, nameFromThen;
40 extern Name nameFromTo, nameFromThenTo;
41 extern Name nameFatbar, nameFail; /* primitives reqd for translation */
42 extern Name nameIf, nameSel;
43 extern Name nameCompAux;
44 extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
45 extern Name namePmInteger;
46 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 nameComp, nameApp; /* composition and append */
62 extern Name nameShowField; /* display single field */
63 extern Name nameShowParen; /* wrap with parens */
64 extern Name nameReadField; /* read single field */
65 extern Name nameReadParen; /* unwrap from parens */
66 extern Name nameLex; /* lexer */
67 extern Name nameRangeSize; /* calculate size of index range */
68 extern Name nameReturn, nameBind; /* for translating monad comps */
69 extern Name nameMFail;
70 extern Name nameListMonad; /* builder function for List Monad */
71 extern Name namePrint; /* printing primitive */
72 extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */
74 extern Name namePutStr;
75 extern Name nameRunIO_toplevel;
77 /* The following data constructors are used to make boxed but
78 * unpointed values pointed and require no special treatment
79 * by the code generator. */
80 extern Name nameMkInteger;
81 extern Name nameMkPrimArray;
82 extern Name nameMkPrimByteArray;
83 extern Name nameMkRef;
84 extern Name nameMkPrimMutableArray;
85 extern Name nameMkPrimMutableByteArray;
86 extern Name nameMkThreadId;
87 extern Name nameMkPrimMVar;
88 #ifdef PROVIDE_FOREIGN
89 extern Name nameMkForeign;
92 extern Name nameMkWeak;
95 /* The following data constructors are used to box unboxed
96 * arguments and are treated differently by the code generator.
97 * That is, they have primop `elem` {INT_REP,FLOAT_REP,...}. */
98 #define boxingConRep(con) ((AsmRep)(name(con).primop))
99 #define isBoxingCon(con) (isName(con) && boxingConRep(con) != 0)
106 extern Name nameMkStable;
108 /* used while desugaring */
110 extern Name nameOtherwise;
111 extern Name nameUndefined; /* generic undefined value */
113 /* used in pattern match */
114 extern Name namePmSub;
117 /* used in translation */
119 extern Name namePMFail;
120 extern Name nameEqChar;
121 extern Name nameEqInteger;
122 extern Name namePmInt;
123 extern Name namePmInteger;
124 extern Name namePmDouble;
125 extern Name namePmLe;
126 extern Name namePmSubtract;
127 extern Name namePmFromInteger;
128 extern Name nameMkIO;
129 extern Name nameUnpackString;
130 extern Name namePrimSeq;
132 extern Name nameMinus;
134 /* assertion and exceptions */
135 extern Name nameAssert;
136 extern Name nameAssertError;
137 extern Name nameTangleMessage;
138 extern Name nameIrrefutPatError;
139 extern Name nameNoMethodBindingError;
140 extern Name nameNonExhaustiveGuardsError;
141 extern Name namePatError;
142 extern Name nameRecSelError;
143 extern Name nameRecConError;
144 extern Name nameRecUpdError;
147 extern Class classMonad; /* Monads */
148 extern Class classEq; /* `standard' classes */
149 extern Class classOrd;
150 extern Class classShow;
151 extern Class classRead;
152 extern Class classIx;
153 extern Class classEnum;
154 extern Class classBounded;
155 extern Class classReal; /* `numeric' classes */
156 extern Class classIntegral;
157 extern Class classRealFrac;
158 extern Class classRealFloat;
159 extern Class classFractional;
160 extern Class classFloating;
161 extern Class classNum;
164 extern Type typeProgIO; /* For the IO monad, IO a */
165 extern Type typeArrow; /* Builtin type constructors */
166 extern Type typeList;
167 extern Type typeUnit;
168 extern Type typeInt64;
169 extern Type typeWord;
170 extern Type typeFloat;
171 extern Type typePrimArray;
172 extern Type typePrimByteArray;
174 extern Type typePrimMutableArray;
175 extern Type typePrimMutableByteArray;
176 extern Type typeStable;
177 extern Type typeWeak;
179 extern Type typeForeign;
180 extern Type typeMVar;
181 extern Type typeThreadId;
182 extern Type typeException;
185 extern Type typeOrdering;
186 extern List stdDefaults; /* List of standard default types */
188 /* For every primitive type provided by the runtime system,
189 * we construct a Haskell type using a declaration of the form:
191 * data Int -- no constructors given
193 extern Type typeChar;
195 extern Type typeInteger;
196 extern Type typeWord;
197 extern Type typeAddr;
198 extern Type typePrimArray;
199 extern Type typePrimByteArray;
201 extern Type typePrimMutableArray;
202 extern Type typePrimMutableByteArray;
203 extern Type typeFloat;
204 extern Type typeDouble;
205 extern Type typeStable;
206 extern Type typeThreadId;
207 extern Type typeMVar;
209 extern Type typeWeak;
211 #ifdef PROVIDE_FOREIGN
212 extern Type typeForeign;
215 /* And a smaller number of types defined in plain Haskell */
216 extern Type typeList;
217 extern Type typeUnit;
218 extern Type typeString;
219 extern Type typeBool;
222 extern Type typeException;
224 extern Module modulePrelPrim;
225 extern Module modulePrelude;
227 extern Kind starToStar; /* Type -> Type */
231 extern Name nameRecExt; /* Extend a record */
232 extern Name nameRecBrk; /* Break a record */
233 extern Name nameAddEv; /* Addition of evidence values */
234 extern Name nameRecSel; /* Select a record */
235 extern Name nameRecShw; /* Show a record */
236 extern Name nameShowRecRow; /* Used to output rows */
237 extern Name nameRecEq; /* Compare records */
238 extern Name nameEqRecRow; /* Used to compare rows */
239 extern Name nameInsFld; /* Field insertion routine */
240 extern Name nameNoRec; /* The empty record */
241 extern Type typeNoRow; /* The empty row */
242 extern Type typeRec; /* Record formation */
243 extern Kind extKind; /* Kind of extension, *->row->row */
247 /* --------------------------------------------------------------------------
248 * Constructions from the above names, types, etc.
249 * ------------------------------------------------------------------------*/
252 extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
253 extern Type listof; /* [ mkOffset(0) ] */
254 extern Cell predNum; /* Num (mkOffset(0)) */
255 extern Cell predFractional; /* Fractional (mkOffset(0)) */
256 extern Cell predIntegral; /* Integral (mkOffset(0)) */
257 extern Cell predMonad; /* Monad (mkOffset(0)) */
259 extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
260 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
261 extern Type listof; /* [ mkOffset(0) ] */
262 extern Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
264 extern Cell predNum; /* Num (mkOffset(0)) */
265 extern Cell predFractional; /* Fractional (mkOffset(0)) */
266 extern Cell predIntegral; /* Integral (mkOffset(0)) */
267 extern Kind starToStar; /* Type -> Type */
268 extern Cell predMonad; /* Monad (mkOffset(0)) */
270 #define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */
272 #define aVar mkOffset(0) /* Simple skeleton for type var */
273 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
275 #define consChar(c) ap(nameCons,mkChar(c))
277 /* --------------------------------------------------------------------------
279 * ------------------------------------------------------------------------*/
281 extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
282 extern Bool combined; /* TRUE => combined operation */
283 extern Bool debugSC; /* TRUE => print SC to screen */
284 extern Bool kindExpert; /* TRUE => display kind errors in */
286 extern Bool allowOverlap; /* TRUE => allow overlapping insts */
288 extern String repeatStr; /* Repeat last command string */
289 extern String hugsEdit; /* String for editor command */
290 extern String hugsPath; /* String for file search path */
291 extern String projectPath; /* String for project search path */
293 extern Cell* CStackBase; /* pointer to base of C stack */
295 extern List tyconDefns; /* list of type constructor defns */
296 extern List typeInDefns; /* list of synonym restrictions */
297 extern List valDefns; /* list of value definitions */
298 extern List classDefns; /* list of class definitions */
299 extern List instDefns; /* list of instance definitions */
300 extern List selDefns; /* list of selector lists */
301 extern List genDefns; /* list of generated defns */
302 extern List primDefns; /* list of primitive definitions */
303 extern List unqualImports; /* unqualified import list */
304 extern List defaultDefns; /* default definitions (if any) */
305 extern Int defaultLine; /* line in which default defs occur*/
306 extern List evalDefaults; /* defaults for evaluator */
307 extern Cell inputExpr; /* evaluator input expression */
308 extern Cell inputContext; /* evaluator input expression */
310 extern Cell whnfHead; /* head of term in whnf */
311 extern Int whnfInt; /* integer value of term in whnf */
312 extern Float whnfFloat; /* float value of term in whnf */
313 extern Long numCells; /* number of cells allocated */
314 extern Int numGcs; /* number of garbage collections */
315 extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
316 extern Bool flagAssert; /* TRUE => assert False <e> causes
317 an assertion failure */
319 extern Bool gcMessages; /* TRUE => print GC messages */
320 extern Bool literateScripts; /* TRUE => default lit scripts */
321 extern Bool literateErrors; /* TRUE => report errs in lit scrs */
322 extern Bool showInstRes; /*TRUE => show instance resolution */
324 extern Int cutoff; /* Constraint Cutoff depth */
326 extern List diVars; /* deriving: cache of names */
327 extern Int diNum; /* also for deriving */
328 extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
330 extern Module moduleBeingParsed; /* so the parser (topModule) knows */
334 extern String preprocessor; /* preprocessor command */
338 /* --------------------------------------------------------------------------
339 * Function prototypes etc...
340 * ------------------------------------------------------------------------*/
344 #define RESET 1 /* reset subsystem */
345 #define MARK 2 /* mark parts of graph in use by subsystem */
346 #define PREPREL 3 /* do startup actions before Prelude loading */
347 #define POSTPREL 4 /* do startup actions after Prelude loading */
348 #define EXIT 5 /* Take action immediately before exit() */
349 #define BREAK 6 /* Take action after program break */
350 #define GCDONE 7 /* Restore subsystem invariants after GC */
352 /* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
355 extern Void everybody ( Int );
356 extern Void linkControl ( Int );
357 extern Void deriveControl ( Int );
358 extern Void translateControl ( Int );
359 extern Void codegen ( Int );
360 extern Void machdep ( Int );
361 extern Void liftControl ( Int );
362 extern Void substitution ( Int );
363 extern Void typeChecker ( Int );
364 extern Void interface ( Int );
365 extern Void storage ( Int );
370 extern Void setGoal ( String, Target );
371 extern Void soFar ( Target );
372 extern Void done ( Void );
373 extern String fromEnv ( String,String );
374 extern Bool chase ( List );
376 extern Void input ( Int );
377 extern Void consoleInput ( String );
378 extern Void projInput ( String );
379 extern Void stringInput ( String );
380 extern Cell parseModule ( String,Long );
381 extern Void parseExp ( Void );
382 #if EXPLAIN_INSTANCE_RESOLUTION
383 extern Void parseContext ( Void );
385 extern String readFilename ( Void );
386 extern String readLine ( Void );
387 extern Syntax defaultSyntax ( Text );
388 extern Syntax syntaxOf ( Name );
389 extern String unlexChar ( Char,Char );
390 extern Void printString ( String );
393 extern Void staticAnalysis ( Int );
394 extern Void startModule ( Module );
395 extern Void setExportList ( List );
396 extern Void setExports ( List );
397 extern Void addQualImport ( Text,Text );
398 extern Void addUnqualImport ( Text,List );
400 extern Void tyconDefn ( Int,Cell,Cell,Cell );
401 extern Void setTypeIns ( List );
402 extern Void clearTypeIns ( Void );
403 extern Type fullExpand ( Type );
404 extern Bool isAmbiguous ( Type );
405 extern Void ambigError ( Int,String,Cell,Type );
406 extern Void classDefn ( Int,Cell,List,List );
407 extern Void instDefn ( Int,Cell,Cell );
408 extern Void addTupInst ( Class,Int );
409 extern Name newDSel ( Class,Int );
411 extern Inst addRecShowInst ( Class,Ext );
412 extern Inst addRecEqInst ( Class,Ext );
414 extern List offsetTyvarsIn ( Type,List );
417 extern List typeVarsIn ( Cell,List,List,List );
418 extern List oclose ( List,List );
419 extern List zonkTyvarsIn ( Type,List );
420 extern Type zonkTyvar ( Int );
421 extern Type zonkType ( Type,Int );
422 extern Void primDefn ( Cell,List,Cell );
423 extern Void defaultDefn ( Int,List );
424 extern Void checkExp ( Void );
425 extern Type conToTagType ( Tycon );
426 extern Type tagToConType ( Tycon );
427 extern Int visitClass ( Class );
429 #if EXPLAIN_INSTANCE_RESOLUTION
430 extern Void checkContext ( Void );
432 extern Void checkDefns ( Module );
433 extern Bool h98Pred ( Bool,Cell );
434 extern Cell h98Context ( Bool,List );
435 extern Void h98CheckCtxt ( Int,String,Bool,List,Inst );
436 extern Void h98CheckType ( Int,String,Cell,Type );
437 extern Void h98DoesntSupport ( Int,String );
439 extern Int userArity ( Name );
440 extern List deriveEq ( Tycon );
441 extern List deriveOrd ( Tycon );
442 extern List deriveEnum ( Tycon );
443 extern List deriveIx ( Tycon );
444 extern List deriveShow ( Tycon );
445 extern List deriveRead ( Cell );
446 extern List deriveBounded ( Tycon );
447 extern List checkPrimDefn ( Triple );
449 extern Void foreignImport ( Cell,Text,Pair,Cell,Cell );
450 extern Void foreignExport ( Cell,Text,Cell,Cell,Cell );
452 extern Void implementForeignImport ( Name );
453 extern Void implementForeignExport ( Name );
455 extern List foreignExports; /* foreign export declarations */
456 extern List foreignImports; /* foreign import declarations */
458 extern Type primType ( Int /*AsmMonad*/ monad,
459 String a_kinds, String r_kinds );
461 extern Type typeCheckExp ( Bool );
462 extern Void typeCheckDefns ( Void );
463 extern Cell provePred ( Kinds,List,Cell );
464 extern List simpleContext ( List,Int );
465 extern Cell rhsExpr ( Cell );
466 extern Int rhsLine ( Cell );
467 extern Bool isProgType ( List,Type );
468 extern Cell superEvid ( Cell,Class,Class );
469 extern Void linkPreludeTC ( Void );
470 extern Void linkPreludeCM ( Void );
471 extern Void linkPrimNames ( Void );
473 extern Void compiler ( Int );
474 extern Void compileDefns ( Void );
475 extern Void compileExp ( Void );
476 extern Bool failFree ( Cell );
477 extern Int discrArity ( Cell );
479 extern Addr codeGen ( Name,Int,Cell );
480 extern Void evalExp ( Void );
481 extern Int shellEsc ( String );
482 extern Int getTerminalWidth ( Void );
483 extern Void normalTerminal ( Void );
484 extern Void noechoTerminal ( Void );
485 extern Int readTerminalChar ( Void );
486 extern Void gcStarted ( Void );
487 extern Void gcScanning ( Void );
488 extern Void gcRecovered ( Int );
489 extern Void gcCStack ( Void );
490 extern Void needPrims ( Int );
491 extern List calcFunDepsPreds ( List );
492 extern Inst findInstFor ( Cell,Int );
494 extern List findInstsFor ( Cell,Int );
498 /*---------------------------------------------------------------------------
499 * Debugging printers, and output-ery
500 *-------------------------------------------------------------------------*/
502 extern Void ppScripts ( Void );
503 extern Void ppModules ( Void );
505 extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
507 extern Void ppStg ( Cell /*StgVar*/ v );
508 extern Void ppStgExpr ( Cell /*StgExpr*/ e );
509 extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
510 extern Void ppStgAlts ( List alts );
511 extern Void ppStgPrimAlts ( List alts );
512 extern Void ppStgVars ( List vs );
514 extern Void putChr ( Int );
515 extern Void putStr ( String );
516 extern Void putInt ( Int );
517 extern Void putPtr ( Ptr );
519 extern Void unlexCharConst ( Cell );
520 extern Void unlexStrConst ( Text );
521 extern Void unlexVar ( Text );
522 extern Void unlexVarStr ( String );
524 extern FILE *outputStream; /* current output stream */
525 extern Int outColumn; /* current output column number */
529 /*---------------------------------------------------------------------------
530 * Crude profiling (probably doesn't work)
531 *-------------------------------------------------------------------------*/
533 #ifdef CRUDE_PROFILING
534 extern void cp_init ( void );
535 extern void cp_enter ( Cell /*StgVar*/ );
536 extern void cp_bill_words ( int );
537 extern void cp_bill_insns ( int );
538 extern void cp_show ( void );
542 /*---------------------------------------------------------------------------
543 * For dynamic.c and general object-related stuff
544 *-------------------------------------------------------------------------*/
546 extern void* getDLLSymbol ( Int,String,String );
547 extern Bool stdcallAllowed ( void );
549 #if LEADING_UNDERSCORE
550 #define MAYBE_LEADING_UNDERSCORE(sss) _##sss
551 #define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
553 #define MAYBE_LEADING_UNDERSCORE(sss) sss
554 #define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
558 /*---------------------------------------------------------------------------
559 * Interrupting execution (signals, allowBreak):
560 *-------------------------------------------------------------------------*/
563 enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt }
566 extern HugsBreakAction currentBreakAction;
567 extern HugsBreakAction setBreakAction ( HugsBreakAction );
570 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
574 /* ctrlbrk: set the interrupt handler.
575 Hugs relies on being able to do sigprocmask, since some of
576 the signal handlers do longjmps, and this zaps the previous
577 signal mask. So setHandler needs to do sigprocmask in order
578 to get the signal mask to a sane state each time.
581 #define setHandler(bh) { sigset_t mask; \
583 sigemptyset(&mask); \
584 sigaddset(&mask, SIGINT); \
585 sigprocmask(SIG_UNBLOCK, &mask, NULL); \
589 /*---------------------------------------------------------------------------
590 * Environment variables and the registry
591 *-------------------------------------------------------------------------*/
593 #define N_INSTALLDIR 200
594 extern char installDir[N_INSTALLDIR];
597 /*---------------------------------------------------------------------------
599 *-------------------------------------------------------------------------*/
602 # include <sys/types.h>
606 extern int chdir ( const char* );
611 extern int system ( const char * );
612 extern double atof ( const char * );
613 extern void exit ( int );
616 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
617 #define FILENAME_MAX 256
619 #if FILENAME_MAX < 256
621 #define FILENAME_MAX 256
625 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
626 #define DOS_FILENAMES HAVE_DOS_H
627 /* ToDo: can we replace this with a feature test? */
628 #define MAC_FILENAMES SYMANTEC_C
630 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
632 #if CASE_INSENSITIVE_FILENAMES
634 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
636 # define filenamecmp(s1,s2) _stricmp(s1,s2)
638 # define filenamecmp(s1,s2) stricmp(s1,s2)
640 # define filenamecmp(s1,s2) strcmpi(s1,s2)
643 # define filenamecmp(s1,s2) strcmp(s1,s2)
646 #define HI_ENDING ".u_hi"
649 /*---------------------------------------------------------------------------
650 * Pipe-related operations:
652 * On Windows, many standard Unix names acquire a leading underscore.
653 * Irritating, but easy to work around.
654 *-------------------------------------------------------------------------*/
656 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
657 #define popen(x,y) _popen(x,y)
659 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
660 #define pclose(x) _pclose(x)
664 /*---------------------------------------------------------------------------
666 *-------------------------------------------------------------------------*/
668 #define bitArraySize(n) ((n)/bitsPerWord + 1)
669 #define placeInSet(n) ((-(n)-1)>>wordShift)
670 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
673 /*---------------------------------------------------------------------------
674 * Function prototypes for code in machdep.c
675 *-------------------------------------------------------------------------*/
677 extern String findMPathname ( String,String,String );
678 extern String findPathname ( String,String );
679 extern Int shellEsc ( String );
680 extern Int getTerminalWidth ( Void );
681 extern Void normalTerminal ( Void );
682 extern Void noechoTerminal ( Void );
683 extern Int readTerminalChar ( Void );
684 extern Void gcStarted ( Void );
685 extern Void gcScanning ( Void );
686 extern Void gcRecovered ( Int );
687 extern Void gcCStack ( Void );
690 /*---------------------------------------------------------------------------
691 * To do with reading interface and object files
692 *-------------------------------------------------------------------------*/
694 extern Cell parseInterface ( String,Long );
695 extern List getInterfaceImports ( Cell );
696 extern void processInterfaces ( List );
697 extern Void getFileSize ( String, Long * );
698 extern Void ifLinkConstrItbl ( Name n );
699 extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
700 extern void* lookupObjName ( char* );
702 extern String getExtraObjectInfo ( String primaryObjectName,
703 String extraFileName,
704 Int* extraFileSize );
706 extern List /* of ZTriple(I_INTERFACE,
707 Text--name of obj file,
708 Int--size of obj file) */
712 /* --------------------------------------------------------------------------
713 * Interpreter command structure
714 * ------------------------------------------------------------------------*/
723 extern Command readCommand ( struct cmd *, Char, Char );
751 /* --------------------------------------------------------------------------
754 * Rhs -> STGCON (Con, [Atom])
755 * | STGAPP (Var, [Atom]) -- delayed application
758 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
759 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
760 * | CASE (Expr,[Alt]) -- algebraic case
761 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
762 * | STGPRIM (Prim,[Atom])
763 * | STGAPP (Var, [Atom]) -- tail call
764 * | Var -- Abbreviation for STGAPP(Var,[])
769 * | BIGNUM -- unboxed
774 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
775 * | Name -- let-bound (effectively)
776 * -- always unboxed (PTR_REP)
778 * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
779 * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
780 * -- Con is Name or TUPLE
781 * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
783 * We use pointer equality to distinguish variables.
784 * The info field of a Var is used as follows in various phases:
786 * Translation: unused (set to NIL on output)
787 * Freevar analysis: list of free vars after
788 * Lambda lifting: freevar list or UNIT on input, discarded after
789 * Code generation: unused
790 * Optimisation: number of uses (sort-of) of let-bound variable
791 * ------------------------------------------------------------------------*/
794 typedef Cell StgExpr;
795 typedef Cell StgAtom;
796 typedef Cell StgVar; /* Could be a Name or an STGVAR */
797 typedef Cell StgCaseAlt;
798 typedef Cell StgPrimAlt;
799 typedef Cell StgDiscr;
800 typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
802 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
803 #define stgLetBinds(e) fst(snd(e))
804 #define stgLetBody(e) snd(snd(e))
806 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
807 #define stgVarBody(e) fst3(snd(e))
808 #define stgVarRep(e) snd3(snd(e))
809 #define stgVarInfo(e) thd3(snd(e))
811 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
812 #define stgCaseScrut(e) fst(snd(e))
813 #define stgCaseAlts(e) snd(snd(e))
815 #define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e))
816 #define stgCaseAltCon(alt) fst3(snd(alt))
817 #define stgCaseAltVars(alt) snd3(snd(alt))
818 #define stgCaseAltBody(alt) thd3(snd(alt))
820 #define mkStgDefault(v,e) ap(DEEFALT,pair(v,e))
821 #define stgDefaultVar(alt) fst(snd(alt))
822 #define stgDefaultBody(alt) snd(snd(alt))
823 #define isDefaultAlt(alt) (fst(alt)==DEEFALT)
825 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
826 #define stgPrimCaseScrut(e) fst(snd(e))
827 #define stgPrimCaseAlts(e) snd(snd(e))
829 #define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
830 #define stgPrimAltVars(alt) fst(snd(alt))
831 #define stgPrimAltBody(alt) snd(snd(alt))
833 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
834 #define stgAppFun(e) fst(snd(e))
835 #define stgAppArgs(e) snd(snd(e))
837 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
838 #define stgPrimOp(e) fst(snd(e))
839 #define stgPrimArgs(e) snd(snd(e))
841 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
842 #define stgConCon(e) fst(snd(e))
843 #define stgConArgs(e) snd(snd(e))
845 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
846 #define stgLambdaArgs(e) fst(snd(e))
847 #define stgLambdaBody(e) snd(snd(e))
850 /* --------------------------------------------------------------------------
851 * Utility functions for manipulating STG syntax trees.
852 * ------------------------------------------------------------------------*/
854 extern int stgConTag ( StgDiscr d );
855 extern void* stgConInfo ( StgDiscr d );
856 extern int stgDiscrTag ( StgDiscr d );
858 extern List makeArgs ( Int );
859 extern StgExpr makeStgLambda ( List args, StgExpr body );
860 extern StgExpr makeStgApp ( StgVar fun, List args );
861 extern StgExpr makeStgLet ( List binds, StgExpr body );
862 extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 );
863 extern Bool isStgVar ( StgRhs rhs );
864 extern Bool isAtomic ( StgRhs rhs );
865 extern StgVar mkStgVar ( StgRhs rhs, Cell info );
867 #define mkStgRep(c) mkChar(c)
870 /* --------------------------------------------------------------------------
871 * STG/backendish functions
872 * ------------------------------------------------------------------------*/
874 extern Void stgDefn ( Name n, Int arity, Cell e );
876 extern Void implementForeignImport ( Name );
877 extern Void implementForeignExport ( Name );
878 extern Void implementCfun ( Name, List );
879 extern Void implementConToTag ( Tycon );
880 extern Void implementTagToCon ( Tycon );
881 extern Void implementPrim ( Name );
882 extern Void implementTuple ( Int );
884 extern Name implementRecShw ( Text );
885 extern Name implementRecEq ( Text );
888 /* Association list storing globals assigned to dictionaries, tuples, etc */
889 extern List stgGlobals;
891 extern List liftBinds ( List binds );
892 extern StgExpr substExpr ( List sub, StgExpr e );
893 extern List freeVarsBind ( List, StgVar );
896 extern Void cgBinds ( StgRhs );
897 extern void* closureOfVar ( StgVar );
898 extern char* lookupHugsName ( void* );
901 /* --------------------------------------------------------------------------
902 * Definitions for substitution data structure and operations.
903 * ------------------------------------------------------------------------*/
905 typedef struct { /* Each type variable contains: */
906 Type bound; /* A type skeleton (unbound==NIL) */
907 Int offs; /* Offset for skeleton */
908 Kind kind; /* kind annotation */
911 extern Tyvar *tyvars; /* storage for type variables */
912 extern Int typeOff; /* offset of result type */
913 extern Type typeIs; /* skeleton of result type */
914 extern Int typeFree; /* freedom in instantiated type */
915 extern List predsAre; /* list of predicates in type */
916 extern List genericVars; /* list of generic vars */
917 extern List btyvars; /* explicitly scoped type vars */
919 #define tyvar(n) (tyvars+(n)) /* nth type variable */
920 #define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
921 #define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
922 #define aVar mkOffset(0) /* Simple skeletons for type vars */
923 #define bVar mkOffset(1)
924 #define enterBtyvs() btyvars = cons(NIL,btyvars)
925 #define leaveBtyvs() btyvars = tl(btyvars)
927 #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
932 /* offs values when isNull(bound): */
933 #define FIXED_TYVAR 0 /* fixed in current assumption */
934 #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
935 #define GENERIC 2 /* GENERIC+n==nth generic var found*/
937 extern char *unifyFails; /* Unification error message */
939 extern Void emptySubstitution ( Void );
940 extern Int newTyvars ( Int );
941 #define newKindvars(n) newTyvars(n)
942 extern Int newKindedVars ( Kind );
943 extern Kind simpleKind ( Int );
944 extern Void instantiate ( Type );
946 extern Pair findBtyvs ( Text );
947 extern Void markBtyvs ( Void );
948 extern Type localizeBtyvs ( Type );
950 extern Tyvar *getTypeVar ( Type,Int );
951 extern Void tyvarType ( Int );
952 extern Void bindTv ( Int,Type,Int );
953 extern Cell getDerefHead ( Type,Int );
954 extern Void expandSyn ( Tycon, Int, Type *, Int * );
956 extern Void clearMarks ( Void );
957 extern Void markAllVars ( Void );
958 extern Void resetGenerics ( Void );
959 extern Void markTyvar ( Int );
960 extern Void markType ( Type,Int );
961 extern Void markPred ( Cell );
963 extern Type copyTyvar ( Int );
964 extern Type copyType ( Type,Int );
965 extern Cell copyPred ( Cell,Int );
966 extern Type dropRank2 ( Type,Int,Int );
967 extern Type dropRank1 ( Type,Int,Int );
968 extern Void liftRank2Args ( List,Int,Int );
969 extern Type liftRank2 ( Type,Int,Int );
970 extern Type liftRank1 ( Type,Int,Int );
972 extern Type debugTyvar ( Int );
973 extern Type debugType ( Type,Int );
975 extern Kind copyKindvar ( Int );
976 extern Kind copyKind ( Kind,Int );
978 extern Bool eqKind ( Kind,Kind );
979 extern Kind getKind ( Cell,Int );
981 extern List genvarTyvar ( Int,List );
982 extern List genvarType ( Type,Int,List );
984 extern Bool doesntOccurIn ( Tyvar*,Type,Int );
985 extern Bool unify ( Type,Int,Type,Int );
986 extern Bool kunify ( Kind,Int,Kind,Int );
988 extern Void typeTuple ( Cell );
989 extern Void varKind ( Int );
991 extern Bool samePred ( Cell,Int,Cell,Int );
992 extern Bool matchPred ( Cell,Int,Cell,Int );
993 extern Bool unifyPred ( Cell,Int,Cell,Int );
994 extern Inst findInstFor ( Cell,Int );
996 extern Void improve ( Int,List,List );
997 extern Void improve1 ( Int,List,Cell,Int );
999 extern Bool sameSchemes ( Type,Type );
1000 extern Bool sameType ( Type,Int,Type,Int );
1001 extern Bool matchType ( Type,Int,Type,Int );
1002 extern Bool typeMatches ( Type,Type );
1005 extern Void checkBytecodeCount ( Void );
1007 /*-------------------------------------------------------------------------*/