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/04 15:41:56 $
14 * ------------------------------------------------------------------------*/
16 /* --------------------------------------------------------------------------
17 * Connections to Prelude entities:
18 * Texts, Names, Instances, Classes, Types, Kinds and Modules
19 * ------------------------------------------------------------------------*/
21 extern Text textPrimPrel;
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 modulePrimPrel;
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]) */
331 extern String preprocessor; /* preprocessor command */
335 /* --------------------------------------------------------------------------
336 * Function prototypes etc...
337 * ------------------------------------------------------------------------*/
341 #define RESET 1 /* reset subsystem */
342 #define MARK 2 /* mark parts of graph in use by subsystem */
343 #define PREPREL 3 /* do startup actions before Prelude loading */
344 #define POSTPREL 4 /* do startup actions after Prelude loading */
345 #define EXIT 5 /* Take action immediately before exit() */
346 #define BREAK 6 /* Take action after program break */
347 #define GCDONE 7 /* Restore subsystem invariants after GC */
349 /* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
352 extern Void everybody ( Int );
353 extern Void linkControl ( Int );
354 extern Void deriveControl ( Int );
355 extern Void translateControl ( Int );
356 extern Void codegen ( Int );
357 extern Void machdep ( Int );
358 extern Void liftControl ( Int );
359 extern Void substitution ( Int );
360 extern Void typeChecker ( Int );
361 extern Void interface ( Int );
362 extern Void storage ( Int );
367 extern Void setGoal ( String, Target );
368 extern Void soFar ( Target );
369 extern Void done ( Void );
370 extern String fromEnv ( String,String );
371 extern Bool chase ( List );
373 extern Void input ( Int );
374 extern Void consoleInput ( String );
375 extern Void projInput ( String );
376 extern Void stringInput ( String );
377 extern Cell parseModule ( String,Long );
378 extern Void parseExp ( Void );
379 #if EXPLAIN_INSTANCE_RESOLUTION
380 extern Void parseContext ( Void );
382 extern String readFilename ( Void );
383 extern String readLine ( Void );
384 extern Syntax defaultSyntax ( Text );
385 extern Syntax syntaxOf ( Name );
386 extern String unlexChar ( Char,Char );
387 extern Void printString ( String );
390 extern Void staticAnalysis ( Int );
391 extern Void startModule ( Module );
392 extern Void setExportList ( List );
393 extern Void setExports ( List );
394 extern Void addQualImport ( Text,Text );
395 extern Void addUnqualImport ( Text,List );
397 extern Void tyconDefn ( Int,Cell,Cell,Cell );
398 extern Void setTypeIns ( List );
399 extern Void clearTypeIns ( Void );
400 extern Type fullExpand ( Type );
401 extern Bool isAmbiguous ( Type );
402 extern Void ambigError ( Int,String,Cell,Type );
403 extern Void classDefn ( Int,Cell,List,List );
404 extern Void instDefn ( Int,Cell,Cell );
405 extern Void addTupInst ( Class,Int );
406 extern Name newDSel ( Class,Int );
408 extern Inst addRecShowInst ( Class,Ext );
409 extern Inst addRecEqInst ( Class,Ext );
411 extern List offsetTyvarsIn ( Type,List );
414 extern List typeVarsIn ( Cell,List,List,List );
415 extern List oclose ( List,List );
416 extern List zonkTyvarsIn ( Type,List );
417 extern Type zonkTyvar ( Int );
418 extern Type zonkType ( Type,Int );
419 extern Void primDefn ( Cell,List,Cell );
420 extern Void defaultDefn ( Int,List );
421 extern Void checkExp ( Void );
422 extern Type conToTagType ( Tycon );
423 extern Type tagToConType ( Tycon );
424 extern Int visitClass ( Class );
426 #if EXPLAIN_INSTANCE_RESOLUTION
427 extern Void checkContext ( Void );
429 extern Void checkDefns ( Module );
430 extern Bool h98Pred ( Bool,Cell );
431 extern Cell h98Context ( Bool,List );
432 extern Void h98CheckCtxt ( Int,String,Bool,List,Inst );
433 extern Void h98CheckType ( Int,String,Cell,Type );
434 extern Void h98DoesntSupport ( Int,String );
436 extern Int userArity ( Name );
437 extern List deriveEq ( Tycon );
438 extern List deriveOrd ( Tycon );
439 extern List deriveEnum ( Tycon );
440 extern List deriveIx ( Tycon );
441 extern List deriveShow ( Tycon );
442 extern List deriveRead ( Cell );
443 extern List deriveBounded ( Tycon );
444 extern List checkPrimDefn ( Triple );
446 extern Void foreignImport ( Cell,Text,Pair,Cell,Cell );
447 extern Void foreignExport ( Cell,Text,Cell,Cell,Cell );
449 extern Void implementForeignImport ( Name );
450 extern Void implementForeignExport ( Name );
452 extern List foreignExports; /* foreign export declarations */
453 extern List foreignImports; /* foreign import declarations */
455 extern Type primType ( Int /*AsmMonad*/ monad,
456 String a_kinds, String r_kinds );
458 extern Type typeCheckExp ( Bool );
459 extern Void typeCheckDefns ( Void );
460 extern Cell provePred ( Kinds,List,Cell );
461 extern List simpleContext ( List,Int );
462 extern Cell rhsExpr ( Cell );
463 extern Int rhsLine ( Cell );
464 extern Bool isProgType ( List,Type );
465 extern Cell superEvid ( Cell,Class,Class );
466 extern Void linkPreludeTC ( Void );
467 extern Void linkPreludeCM ( Void );
468 extern Void linkPrimNames ( Void );
470 extern Void compiler ( Int );
471 extern Void compileDefns ( Void );
472 extern Void compileExp ( Void );
473 extern Bool failFree ( Cell );
474 extern Int discrArity ( Cell );
476 extern Addr codeGen ( Name,Int,Cell );
477 extern Void evalExp ( Void );
478 extern Int shellEsc ( String );
479 extern Int getTerminalWidth ( Void );
480 extern Void normalTerminal ( Void );
481 extern Void noechoTerminal ( Void );
482 extern Int readTerminalChar ( Void );
483 extern Void gcStarted ( Void );
484 extern Void gcScanning ( Void );
485 extern Void gcRecovered ( Int );
486 extern Void gcCStack ( Void );
487 extern Void needPrims ( Int );
488 extern List calcFunDepsPreds ( List );
489 extern Inst findInstFor ( Cell,Int );
491 extern List findInstsFor ( Cell,Int );
495 /*---------------------------------------------------------------------------
496 * Debugging printers, and output-ery
497 *-------------------------------------------------------------------------*/
499 extern Void ppScripts ( Void );
500 extern Void ppModules ( Void );
502 extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
504 extern Void ppStg ( Cell /*StgVar*/ v );
505 extern Void ppStgExpr ( Cell /*StgExpr*/ e );
506 extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
507 extern Void ppStgAlts ( List alts );
508 extern Void ppStgPrimAlts ( List alts );
509 extern Void ppStgVars ( List vs );
511 extern Void putChr ( Int );
512 extern Void putStr ( String );
513 extern Void putInt ( Int );
514 extern Void putPtr ( Ptr );
516 extern Void unlexCharConst ( Cell );
517 extern Void unlexStrConst ( Text );
518 extern Void unlexVar ( Text );
519 extern Void unlexVarStr ( String );
521 extern FILE *outputStream; /* current output stream */
522 extern Int outColumn; /* current output column number */
526 /*---------------------------------------------------------------------------
527 * Crude profiling (probably doesn't work)
528 *-------------------------------------------------------------------------*/
530 #ifdef CRUDE_PROFILING
531 extern void cp_init ( void );
532 extern void cp_enter ( Cell /*StgVar*/ );
533 extern void cp_bill_words ( int );
534 extern void cp_bill_insns ( int );
535 extern void cp_show ( void );
539 /*---------------------------------------------------------------------------
540 * For dynamic.c and general object-related stuff
541 *-------------------------------------------------------------------------*/
543 extern void* getDLLSymbol ( Int,String,String );
544 extern Bool stdcallAllowed ( void );
546 #if LEADING_UNDERSCORE
547 #define MAYBE_LEADING_UNDERSCORE(sss) _##sss
548 #define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
550 #define MAYBE_LEADING_UNDERSCORE(sss) sss
551 #define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
555 /*---------------------------------------------------------------------------
556 * Interrupting execution (signals, allowBreak):
557 *-------------------------------------------------------------------------*/
560 enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt }
563 extern HugsBreakAction currentBreakAction;
564 extern HugsBreakAction setBreakAction ( HugsBreakAction );
567 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
571 /* ctrlbrk: set the interrupt handler.
572 Hugs relies on being able to do sigprocmask, since some of
573 the signal handlers do longjmps, and this zaps the previous
574 signal mask. So setHandler needs to do sigprocmask in order
575 to get the signal mask to a sane state each time.
578 #define setHandler(bh) { sigset_t mask; \
580 sigemptyset(&mask); \
581 sigaddset(&mask, SIGINT); \
582 sigprocmask(SIG_UNBLOCK, &mask, NULL); \
586 /*---------------------------------------------------------------------------
587 * Environment variables and the registry
588 *-------------------------------------------------------------------------*/
590 /* On Win32 we can use the registry to supplement info in environment
593 /* AJG: Commented out for now for development */
594 /* #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) */
597 Bool writeRegString ( String var, String val );
598 String readRegString ( String var, String def );
599 Int readRegInt ( String var, Int def );
600 Bool writeRegInt ( String var, Int val );
603 #define N_INSTALLDIR 200
604 extern char installDir[N_INSTALLDIR];
607 /*---------------------------------------------------------------------------
609 *-------------------------------------------------------------------------*/
612 # include <sys/types.h>
616 extern int chdir ( const char* );
621 extern int system ( const char * );
622 extern double atof ( const char * );
623 extern void exit ( int );
626 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
627 #define FILENAME_MAX 256
629 #if FILENAME_MAX < 256
631 #define FILENAME_MAX 256
635 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
636 #define DOS_FILENAMES HAVE_DOS_H
637 /* ToDo: can we replace this with a feature test? */
638 #define MAC_FILENAMES SYMANTEC_C
640 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
642 #if CASE_INSENSITIVE_FILENAMES
644 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
646 # define filenamecmp(s1,s2) _stricmp(s1,s2)
648 # define filenamecmp(s1,s2) stricmp(s1,s2)
650 # define filenamecmp(s1,s2) strcmpi(s1,s2)
653 # define filenamecmp(s1,s2) strcmp(s1,s2)
656 #define HI_ENDING ".u_hi"
659 /*---------------------------------------------------------------------------
660 * Pipe-related operations:
662 * On Windows, many standard Unix names acquire a leading underscore.
663 * Irritating, but easy to work around.
664 *-------------------------------------------------------------------------*/
666 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
667 #define popen(x,y) _popen(x,y)
669 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
670 #define pclose(x) _pclose(x)
674 /*---------------------------------------------------------------------------
676 *-------------------------------------------------------------------------*/
678 #define bitArraySize(n) ((n)/bitsPerWord + 1)
679 #define placeInSet(n) ((-(n)-1)>>wordShift)
680 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
683 /*---------------------------------------------------------------------------
684 * Function prototypes for code in machdep.c
685 *-------------------------------------------------------------------------*/
687 extern String findMPathname ( String,String,String );
688 extern String findPathname ( String,String );
689 extern Int shellEsc ( String );
690 extern Int getTerminalWidth ( Void );
691 extern Void normalTerminal ( Void );
692 extern Void noechoTerminal ( Void );
693 extern Int readTerminalChar ( Void );
694 extern Void gcStarted ( Void );
695 extern Void gcScanning ( Void );
696 extern Void gcRecovered ( Int );
697 extern Void gcCStack ( Void );
700 /*---------------------------------------------------------------------------
701 * To do with reading interface and object files
702 *-------------------------------------------------------------------------*/
704 extern Cell parseInterface ( String,Long );
705 extern List getInterfaceImports ( Cell );
706 extern void processInterfaces ( List );
707 extern Void getFileSize ( String, Long * );
708 extern Void ifLinkConstrItbl ( Name n );
709 extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
710 extern void* lookupObjName ( char* );
712 extern String getExtraObjectInfo ( String primaryObjectName,
713 String extraFileName,
714 Int* extraFileSize );
716 extern List /* of ZTriple(I_INTERFACE,
717 Text--name of obj file,
718 Int--size of obj file) */
722 /* --------------------------------------------------------------------------
723 * Interpreter command structure
724 * ------------------------------------------------------------------------*/
733 extern Command readCommand ( struct cmd *, Char, Char );
761 /* --------------------------------------------------------------------------
764 * Rhs -> STGCON (Con, [Atom])
765 * | STGAPP (Var, [Atom]) -- delayed application
768 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
769 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
770 * | CASE (Expr,[Alt]) -- algebraic case
771 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
772 * | STGPRIM (Prim,[Atom])
773 * | STGAPP (Var, [Atom]) -- tail call
774 * | Var -- Abbreviation for STGAPP(Var,[])
779 * | BIGNUM -- unboxed
784 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
785 * | Name -- let-bound (effectively)
786 * -- always unboxed (PTR_REP)
788 * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
789 * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
790 * -- Con is Name or TUPLE
791 * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
793 * We use pointer equality to distinguish variables.
794 * The info field of a Var is used as follows in various phases:
796 * Translation: unused (set to NIL on output)
797 * Freevar analysis: list of free vars after
798 * Lambda lifting: freevar list or UNIT on input, discarded after
799 * Code generation: unused
800 * Optimisation: number of uses (sort-of) of let-bound variable
801 * ------------------------------------------------------------------------*/
804 typedef Cell StgExpr;
805 typedef Cell StgAtom;
806 typedef Cell StgVar; /* Could be a Name or an STGVAR */
807 typedef Cell StgCaseAlt;
808 typedef Cell StgPrimAlt;
809 typedef Cell StgDiscr;
810 typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
812 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
813 #define stgLetBinds(e) fst(snd(e))
814 #define stgLetBody(e) snd(snd(e))
816 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
817 #define stgVarBody(e) fst3(snd(e))
818 #define stgVarRep(e) snd3(snd(e))
819 #define stgVarInfo(e) thd3(snd(e))
821 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
822 #define stgCaseScrut(e) fst(snd(e))
823 #define stgCaseAlts(e) snd(snd(e))
825 #define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e))
826 #define stgCaseAltCon(alt) fst3(snd(alt))
827 #define stgCaseAltVars(alt) snd3(snd(alt))
828 #define stgCaseAltBody(alt) thd3(snd(alt))
830 #define mkStgDefault(v,e) ap(DEEFALT,pair(v,e))
831 #define stgDefaultVar(alt) fst(snd(alt))
832 #define stgDefaultBody(alt) snd(snd(alt))
833 #define isDefaultAlt(alt) (fst(alt)==DEEFALT)
835 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
836 #define stgPrimCaseScrut(e) fst(snd(e))
837 #define stgPrimCaseAlts(e) snd(snd(e))
839 #define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
840 #define stgPrimAltVars(alt) fst(snd(alt))
841 #define stgPrimAltBody(alt) snd(snd(alt))
843 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
844 #define stgAppFun(e) fst(snd(e))
845 #define stgAppArgs(e) snd(snd(e))
847 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
848 #define stgPrimOp(e) fst(snd(e))
849 #define stgPrimArgs(e) snd(snd(e))
851 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
852 #define stgConCon(e) fst(snd(e))
853 #define stgConArgs(e) snd(snd(e))
855 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
856 #define stgLambdaArgs(e) fst(snd(e))
857 #define stgLambdaBody(e) snd(snd(e))
860 /* --------------------------------------------------------------------------
861 * Utility functions for manipulating STG syntax trees.
862 * ------------------------------------------------------------------------*/
864 extern int stgConTag ( StgDiscr d );
865 extern void* stgConInfo ( StgDiscr d );
866 extern int stgDiscrTag ( StgDiscr d );
868 extern List makeArgs ( Int );
869 extern StgExpr makeStgLambda ( List args, StgExpr body );
870 extern StgExpr makeStgApp ( StgVar fun, List args );
871 extern StgExpr makeStgLet ( List binds, StgExpr body );
872 extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 );
873 extern Bool isStgVar ( StgRhs rhs );
874 extern Bool isAtomic ( StgRhs rhs );
875 extern StgVar mkStgVar ( StgRhs rhs, Cell info );
877 #define mkStgRep(c) mkChar(c)
880 /* --------------------------------------------------------------------------
881 * STG/backendish functions
882 * ------------------------------------------------------------------------*/
884 extern Void stgDefn ( Name n, Int arity, Cell e );
886 extern Void implementForeignImport ( Name );
887 extern Void implementForeignExport ( Name );
888 extern Void implementCfun ( Name, List );
889 extern Void implementConToTag ( Tycon );
890 extern Void implementTagToCon ( Tycon );
891 extern Void implementPrim ( Name );
892 extern Void implementTuple ( Int );
894 extern Name implementRecShw ( Text );
895 extern Name implementRecEq ( Text );
898 /* Association list storing globals assigned to dictionaries, tuples, etc */
899 extern List stgGlobals;
901 extern List liftBinds ( List binds );
902 extern StgExpr substExpr ( List sub, StgExpr e );
903 extern List freeVarsBind ( List, StgVar );
906 extern Void cgBinds ( StgRhs );
907 extern void* closureOfVar ( StgVar );
908 extern char* lookupHugsName ( void* );
911 /* --------------------------------------------------------------------------
912 * Definitions for substitution data structure and operations.
913 * ------------------------------------------------------------------------*/
915 typedef struct { /* Each type variable contains: */
916 Type bound; /* A type skeleton (unbound==NIL) */
917 Int offs; /* Offset for skeleton */
918 Kind kind; /* kind annotation */
921 extern Tyvar *tyvars; /* storage for type variables */
922 extern Int typeOff; /* offset of result type */
923 extern Type typeIs; /* skeleton of result type */
924 extern Int typeFree; /* freedom in instantiated type */
925 extern List predsAre; /* list of predicates in type */
926 extern List genericVars; /* list of generic vars */
927 extern List btyvars; /* explicitly scoped type vars */
929 #define tyvar(n) (tyvars+(n)) /* nth type variable */
930 #define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
931 #define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
932 #define aVar mkOffset(0) /* Simple skeletons for type vars */
933 #define bVar mkOffset(1)
934 #define enterBtyvs() btyvars = cons(NIL,btyvars)
935 #define leaveBtyvs() btyvars = tl(btyvars)
937 #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
942 /* offs values when isNull(bound): */
943 #define FIXED_TYVAR 0 /* fixed in current assumption */
944 #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
945 #define GENERIC 2 /* GENERIC+n==nth generic var found*/
947 extern char *unifyFails; /* Unification error message */
949 extern Void emptySubstitution ( Void );
950 extern Int newTyvars ( Int );
951 #define newKindvars(n) newTyvars(n)
952 extern Int newKindedVars ( Kind );
953 extern Kind simpleKind ( Int );
954 extern Void instantiate ( Type );
956 extern Pair findBtyvs ( Text );
957 extern Void markBtyvs ( Void );
958 extern Type localizeBtyvs ( Type );
960 extern Tyvar *getTypeVar ( Type,Int );
961 extern Void tyvarType ( Int );
962 extern Void bindTv ( Int,Type,Int );
963 extern Cell getDerefHead ( Type,Int );
964 extern Void expandSyn ( Tycon, Int, Type *, Int * );
966 extern Void clearMarks ( Void );
967 extern Void markAllVars ( Void );
968 extern Void resetGenerics ( Void );
969 extern Void markTyvar ( Int );
970 extern Void markType ( Type,Int );
971 extern Void markPred ( Cell );
973 extern Type copyTyvar ( Int );
974 extern Type copyType ( Type,Int );
975 extern Cell copyPred ( Cell,Int );
976 extern Type dropRank2 ( Type,Int,Int );
977 extern Type dropRank1 ( Type,Int,Int );
978 extern Void liftRank2Args ( List,Int,Int );
979 extern Type liftRank2 ( Type,Int,Int );
980 extern Type liftRank1 ( Type,Int,Int );
982 extern Type debugTyvar ( Int );
983 extern Type debugType ( Type,Int );
985 extern Kind copyKindvar ( Int );
986 extern Kind copyKind ( Kind,Int );
988 extern Bool eqKind ( Kind,Kind );
989 extern Kind getKind ( Cell,Int );
991 extern List genvarTyvar ( Int,List );
992 extern List genvarType ( Type,Int,List );
994 extern Bool doesntOccurIn ( Tyvar*,Type,Int );
995 extern Bool unify ( Type,Int,Type,Int );
996 extern Bool kunify ( Kind,Int,Kind,Int );
998 extern Void typeTuple ( Cell );
999 extern Void varKind ( Int );
1001 extern Bool samePred ( Cell,Int,Cell,Int );
1002 extern Bool matchPred ( Cell,Int,Cell,Int );
1003 extern Bool unifyPred ( Cell,Int,Cell,Int );
1004 extern Inst findInstFor ( Cell,Int );
1006 extern Void improve ( Int,List,List );
1007 extern Void improve1 ( Int,List,Cell,Int );
1009 extern Bool sameSchemes ( Type,Type );
1010 extern Bool sameType ( Type,Int,Type,Int );
1011 extern Bool matchType ( Type,Int,Type,Int );
1012 extern Bool typeMatches ( Type,Type );
1015 extern Void checkBytecodeCount ( Void );
1017 /*-------------------------------------------------------------------------*/