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/27 16:35:29 $
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 int numEnters; /* number of enters */
316 extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
317 extern Bool flagAssert; /* TRUE => assert False <e> causes
318 an assertion failure */
320 extern Bool gcMessages; /* TRUE => print GC messages */
321 extern Bool literateScripts; /* TRUE => default lit scripts */
322 extern Bool literateErrors; /* TRUE => report errs in lit scrs */
323 extern Bool showInstRes; /*TRUE => show instance resolution */
325 extern Int cutoff; /* Constraint Cutoff depth */
327 extern List diVars; /* deriving: cache of names */
328 extern Int diNum; /* also for deriving */
329 extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
331 extern Module moduleBeingParsed; /* so the parser (topModule) knows */
335 extern String preprocessor; /* preprocessor command */
339 /* --------------------------------------------------------------------------
340 * Function prototypes etc...
341 * ------------------------------------------------------------------------*/
345 #define RESET 1 /* reset subsystem */
346 #define MARK 2 /* mark parts of graph in use by subsystem */
347 #define PREPREL 3 /* do startup actions before Prelude loading */
348 #define POSTPREL 4 /* do startup actions after Prelude loading */
349 #define EXIT 5 /* Take action immediately before exit() */
350 #define BREAK 6 /* Take action after program break */
351 #define GCDONE 7 /* Restore subsystem invariants after GC */
353 /* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
356 extern Void everybody ( Int );
357 extern Void linkControl ( Int );
358 extern Void deriveControl ( Int );
359 extern Void translateControl ( Int );
360 extern Void codegen ( Int );
361 extern Void machdep ( Int );
362 extern Void liftControl ( Int );
363 extern Void substitution ( Int );
364 extern Void typeChecker ( Int );
365 extern Void interface ( Int );
366 extern Void storage ( Int );
371 extern Void setGoal ( String, Target );
372 extern Void soFar ( Target );
373 extern Void done ( Void );
374 extern String fromEnv ( String,String );
375 extern Bool chase ( List );
377 extern Void input ( Int );
378 extern Void consoleInput ( String );
379 extern Void projInput ( String );
380 extern Void stringInput ( String );
381 extern Cell parseModule ( String,Long );
382 extern Void parseExp ( Void );
383 #if EXPLAIN_INSTANCE_RESOLUTION
384 extern Void parseContext ( Void );
386 extern String readFilename ( Void );
387 extern String readLine ( Void );
388 extern Syntax defaultSyntax ( Text );
389 extern Syntax syntaxOf ( Name );
390 extern String unlexChar ( Char,Char );
391 extern Void printString ( String );
394 extern Void staticAnalysis ( Int );
395 extern Void startModule ( Module );
396 extern Void setExportList ( List );
397 extern Void setExports ( List );
398 extern Void addQualImport ( Text,Text );
399 extern Void addUnqualImport ( Text,List );
401 extern Void tyconDefn ( Int,Cell,Cell,Cell );
402 extern Void setTypeIns ( List );
403 extern Void clearTypeIns ( Void );
404 extern Type fullExpand ( Type );
405 extern Bool isAmbiguous ( Type );
406 extern Void ambigError ( Int,String,Cell,Type );
407 extern Void classDefn ( Int,Cell,List,List );
408 extern Void instDefn ( Int,Cell,Cell );
409 extern Void addTupInst ( Class,Int );
410 extern Name newDSel ( Class,Int );
412 extern Inst addRecShowInst ( Class,Ext );
413 extern Inst addRecEqInst ( Class,Ext );
415 extern List offsetTyvarsIn ( Type,List );
418 extern List typeVarsIn ( Cell,List,List,List );
419 extern List oclose ( List,List );
420 extern List zonkTyvarsIn ( Type,List );
421 extern Type zonkTyvar ( Int );
422 extern Type zonkType ( Type,Int );
423 extern Void primDefn ( Cell,List,Cell );
424 extern Void defaultDefn ( Int,List );
425 extern Void checkExp ( Void );
426 extern Type conToTagType ( Tycon );
427 extern Type tagToConType ( Tycon );
428 extern Int visitClass ( Class );
430 #if EXPLAIN_INSTANCE_RESOLUTION
431 extern Void checkContext ( Void );
433 extern Void checkDefns ( Module );
434 extern Bool h98Pred ( Bool,Cell );
435 extern Cell h98Context ( Bool,List );
436 extern Void h98CheckCtxt ( Int,String,Bool,List,Inst );
437 extern Void h98CheckType ( Int,String,Cell,Type );
438 extern Void h98DoesntSupport ( Int,String );
440 extern Int userArity ( Name );
441 extern List deriveEq ( Tycon );
442 extern List deriveOrd ( Tycon );
443 extern List deriveEnum ( Tycon );
444 extern List deriveIx ( Tycon );
445 extern List deriveShow ( Tycon );
446 extern List deriveRead ( Cell );
447 extern List deriveBounded ( Tycon );
448 extern List checkPrimDefn ( Triple );
450 extern Void foreignImport ( Cell,Text,Pair,Cell,Cell );
451 extern Void foreignExport ( Cell,Text,Cell,Cell,Cell );
453 extern Void implementForeignImport ( Name );
454 extern Void implementForeignExport ( Name );
456 extern List foreignExports; /* foreign export declarations */
457 extern List foreignImports; /* foreign import declarations */
459 extern Type primType ( Int /*AsmMonad*/ monad,
460 String a_kinds, String r_kinds );
462 extern Type typeCheckExp ( Bool );
463 extern Void typeCheckDefns ( Void );
464 extern Cell provePred ( Kinds,List,Cell );
465 extern List simpleContext ( List,Int );
466 extern Cell rhsExpr ( Cell );
467 extern Int rhsLine ( Cell );
468 extern Bool isProgType ( List,Type );
469 extern Cell superEvid ( Cell,Class,Class );
470 extern Void linkPreludeTC ( Void );
471 extern Void linkPreludeCM ( Void );
472 extern Void linkPrimNames ( Void );
474 extern Void compiler ( Int );
475 extern Void compileDefns ( Void );
476 extern Void compileExp ( Void );
477 extern Bool failFree ( Cell );
478 extern Int discrArity ( Cell );
480 extern Addr codeGen ( Name,Int,Cell );
481 extern Void evalExp ( Void );
482 extern Int shellEsc ( String );
483 extern Int getTerminalWidth ( Void );
484 extern Void normalTerminal ( Void );
485 extern Void noechoTerminal ( Void );
486 extern Int readTerminalChar ( Void );
487 extern Void gcStarted ( Void );
488 extern Void gcScanning ( Void );
489 extern Void gcRecovered ( Int );
490 extern Void gcCStack ( Void );
491 extern Void needPrims ( Int );
492 extern List calcFunDepsPreds ( List );
493 extern Inst findInstFor ( Cell,Int );
495 extern List findInstsFor ( Cell,Int );
499 /*---------------------------------------------------------------------------
500 * Debugging printers, and output-ery
501 *-------------------------------------------------------------------------*/
503 extern Void ppScripts ( Void );
504 extern Void ppModules ( Void );
506 extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
508 extern Void ppStg ( Cell /*StgVar*/ v );
509 extern Void ppStgExpr ( Cell /*StgExpr*/ e );
510 extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
511 extern Void ppStgAlts ( List alts );
512 extern Void ppStgPrimAlts ( List alts );
513 extern Void ppStgVars ( List vs );
515 extern Void putChr ( Int );
516 extern Void putStr ( String );
517 extern Void putInt ( Int );
518 extern Void putPtr ( Ptr );
520 extern Void unlexCharConst ( Cell );
521 extern Void unlexStrConst ( Text );
522 extern Void unlexVar ( Text );
523 extern Void unlexVarStr ( String );
525 extern FILE *outputStream; /* current output stream */
526 extern Int outColumn; /* current output column number */
530 /*---------------------------------------------------------------------------
531 * Crude profiling (probably doesn't work)
532 *-------------------------------------------------------------------------*/
534 #ifdef CRUDE_PROFILING
535 extern void cp_init ( void );
536 extern void cp_enter ( Cell /*StgVar*/ );
537 extern void cp_bill_words ( int );
538 extern void cp_bill_insns ( int );
539 extern void cp_show ( void );
543 /*---------------------------------------------------------------------------
544 * For dynamic.c and general object-related stuff
545 *-------------------------------------------------------------------------*/
547 extern void* getDLLSymbol ( Int,String,String );
548 extern Bool stdcallAllowed ( void );
550 #if LEADING_UNDERSCORE
551 #define MAYBE_LEADING_UNDERSCORE(sss) _##sss
552 #define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
554 #define MAYBE_LEADING_UNDERSCORE(sss) sss
555 #define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
559 /*---------------------------------------------------------------------------
560 * Interrupting execution (signals, allowBreak):
561 *-------------------------------------------------------------------------*/
564 enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt }
567 extern HugsBreakAction currentBreakAction;
568 extern HugsBreakAction setBreakAction ( HugsBreakAction );
571 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
575 /* ctrlbrk: set the interrupt handler.
576 Hugs relies on being able to do sigprocmask, since some of
577 the signal handlers do longjmps, and this zaps the previous
578 signal mask. So setHandler needs to do sigprocmask in order
579 to get the signal mask to a sane state each time.
582 #define setHandler(bh) { sigset_t mask; \
584 sigemptyset(&mask); \
585 sigaddset(&mask, SIGINT); \
586 sigprocmask(SIG_UNBLOCK, &mask, NULL); \
590 /*---------------------------------------------------------------------------
591 * Environment variables and the registry
592 *-------------------------------------------------------------------------*/
594 #define N_INSTALLDIR 200
595 extern char installDir[N_INSTALLDIR];
598 /*---------------------------------------------------------------------------
600 *-------------------------------------------------------------------------*/
603 # include <sys/types.h>
607 extern int chdir ( const char* );
612 extern int system ( const char * );
613 extern double atof ( const char * );
614 extern void exit ( int );
617 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
618 #define FILENAME_MAX 256
620 #if FILENAME_MAX < 256
622 #define FILENAME_MAX 256
626 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
627 #define DOS_FILENAMES HAVE_DOS_H
628 /* ToDo: can we replace this with a feature test? */
629 #define MAC_FILENAMES SYMANTEC_C
631 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
633 #if CASE_INSENSITIVE_FILENAMES
635 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
637 # define filenamecmp(s1,s2) _stricmp(s1,s2)
639 # define filenamecmp(s1,s2) stricmp(s1,s2)
641 # define filenamecmp(s1,s2) strcmpi(s1,s2)
644 # define filenamecmp(s1,s2) strcmp(s1,s2)
647 #define HI_ENDING ".u_hi"
650 /*---------------------------------------------------------------------------
651 * Pipe-related operations:
653 * On Windows, many standard Unix names acquire a leading underscore.
654 * Irritating, but easy to work around.
655 *-------------------------------------------------------------------------*/
657 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
658 #define popen(x,y) _popen(x,y)
660 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
661 #define pclose(x) _pclose(x)
665 /*---------------------------------------------------------------------------
667 *-------------------------------------------------------------------------*/
669 #define bitArraySize(n) ((n)/bitsPerWord + 1)
670 #define placeInSet(n) ((-(n)-1)>>wordShift)
671 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
674 /*---------------------------------------------------------------------------
675 * Function prototypes for code in machdep.c
676 *-------------------------------------------------------------------------*/
678 extern String findMPathname ( String,String,String );
679 extern String findPathname ( String,String );
680 extern Int shellEsc ( String );
681 extern Int getTerminalWidth ( Void );
682 extern Void normalTerminal ( Void );
683 extern Void noechoTerminal ( Void );
684 extern Int readTerminalChar ( Void );
685 extern Void gcStarted ( Void );
686 extern Void gcScanning ( Void );
687 extern Void gcRecovered ( Int );
688 extern Void gcCStack ( Void );
691 /*---------------------------------------------------------------------------
692 * To do with reading interface and object files
693 *-------------------------------------------------------------------------*/
695 extern Cell parseInterface ( String,Long );
696 extern List getInterfaceImports ( Cell );
697 extern void processInterfaces ( List );
698 extern Void getFileSize ( String, Long * );
699 extern Void ifLinkConstrItbl ( Name n );
700 extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
701 extern void* lookupObjName ( char* );
703 extern String getExtraObjectInfo ( String primaryObjectName,
704 String extraFileName,
705 Int* extraFileSize );
707 extern List /* of ZTriple(I_INTERFACE,
708 Text--name of obj file,
709 Int--size of obj file) */
713 /* --------------------------------------------------------------------------
714 * Interpreter command structure
715 * ------------------------------------------------------------------------*/
724 extern Command readCommand ( struct cmd *, Char, Char );
752 /* --------------------------------------------------------------------------
755 * Rhs -> STGCON (Con, [Atom])
756 * | STGAPP (Var, [Atom]) -- delayed application
759 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
760 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
761 * | CASE (Expr,[Alt]) -- algebraic case
762 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
763 * | STGPRIM (Prim,[Atom])
764 * | STGAPP (Var, [Atom]) -- tail call
765 * | Var -- Abbreviation for STGAPP(Var,[])
770 * | BIGNUM -- unboxed
775 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
776 * | Name -- let-bound (effectively)
777 * -- always unboxed (PTR_REP)
779 * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
780 * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
781 * -- Con is Name or TUPLE
782 * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
784 * We use pointer equality to distinguish variables.
785 * The info field of a Var is used as follows in various phases:
787 * Translation: unused (set to NIL on output)
788 * Freevar analysis: list of free vars after
789 * Lambda lifting: freevar list or UNIT on input, discarded after
790 * Code generation: unused
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 extern void liftModule ( Module );
889 extern StgExpr substExpr ( List sub, StgExpr e );
890 extern List freeVarsBind ( List, StgVar );
893 extern Void cgModule ( Module );
894 extern char* lookupHugsName ( void* );
897 /* --------------------------------------------------------------------------
898 * Definitions for substitution data structure and operations.
899 * ------------------------------------------------------------------------*/
901 typedef struct { /* Each type variable contains: */
902 Type bound; /* A type skeleton (unbound==NIL) */
903 Int offs; /* Offset for skeleton */
904 Kind kind; /* kind annotation */
907 extern Tyvar *tyvars; /* storage for type variables */
908 extern Int typeOff; /* offset of result type */
909 extern Type typeIs; /* skeleton of result type */
910 extern Int typeFree; /* freedom in instantiated type */
911 extern List predsAre; /* list of predicates in type */
912 extern List genericVars; /* list of generic vars */
913 extern List btyvars; /* explicitly scoped type vars */
915 #define tyvar(n) (tyvars+(n)) /* nth type variable */
916 #define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
917 #define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
918 #define aVar mkOffset(0) /* Simple skeletons for type vars */
919 #define bVar mkOffset(1)
920 #define enterBtyvs() btyvars = cons(NIL,btyvars)
921 #define leaveBtyvs() btyvars = tl(btyvars)
923 #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
928 /* offs values when isNull(bound): */
929 #define FIXED_TYVAR 0 /* fixed in current assumption */
930 #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
931 #define GENERIC 2 /* GENERIC+n==nth generic var found*/
933 extern char *unifyFails; /* Unification error message */
935 extern Void emptySubstitution ( Void );
936 extern Int newTyvars ( Int );
937 #define newKindvars(n) newTyvars(n)
938 extern Int newKindedVars ( Kind );
939 extern Kind simpleKind ( Int );
940 extern Void instantiate ( Type );
942 extern Pair findBtyvs ( Text );
943 extern Void markBtyvs ( Void );
944 extern Type localizeBtyvs ( Type );
946 extern Tyvar *getTypeVar ( Type,Int );
947 extern Void tyvarType ( Int );
948 extern Void bindTv ( Int,Type,Int );
949 extern Cell getDerefHead ( Type,Int );
950 extern Void expandSyn ( Tycon, Int, Type *, Int * );
952 extern Void clearMarks ( Void );
953 extern Void markAllVars ( Void );
954 extern Void resetGenerics ( Void );
955 extern Void markTyvar ( Int );
956 extern Void markType ( Type,Int );
957 extern Void markPred ( Cell );
959 extern Type copyTyvar ( Int );
960 extern Type copyType ( Type,Int );
961 extern Cell copyPred ( Cell,Int );
962 extern Type dropRank2 ( Type,Int,Int );
963 extern Type dropRank1 ( Type,Int,Int );
964 extern Void liftRank2Args ( List,Int,Int );
965 extern Type liftRank2 ( Type,Int,Int );
966 extern Type liftRank1 ( Type,Int,Int );
968 extern Type debugTyvar ( Int );
969 extern Type debugType ( Type,Int );
971 extern Kind copyKindvar ( Int );
972 extern Kind copyKind ( Kind,Int );
974 extern Bool eqKind ( Kind,Kind );
975 extern Kind getKind ( Cell,Int );
977 extern List genvarTyvar ( Int,List );
978 extern List genvarType ( Type,Int,List );
980 extern Bool doesntOccurIn ( Tyvar*,Type,Int );
981 extern Bool unify ( Type,Int,Type,Int );
982 extern Bool kunify ( Kind,Int,Kind,Int );
984 extern Void typeTuple ( Cell );
985 extern Void varKind ( Int );
987 extern Bool samePred ( Cell,Int,Cell,Int );
988 extern Bool matchPred ( Cell,Int,Cell,Int );
989 extern Bool unifyPred ( Cell,Int,Cell,Int );
990 extern Inst findInstFor ( Cell,Int );
992 extern Void improve ( Int,List,List );
993 extern Void improve1 ( Int,List,Cell,Int );
995 extern Bool sameSchemes ( Type,Type );
996 extern Bool sameType ( Type,Int,Type,Int );
997 extern Bool matchType ( Type,Int,Type,Int );
998 extern Bool typeMatches ( Type,Type );
1001 extern Void checkBytecodeCount ( Void );
1003 /*-------------------------------------------------------------------------*/