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/03/13 11:37:16 $
14 * ------------------------------------------------------------------------*/
16 /* --------------------------------------------------------------------------
17 * Connections to Prelude entities:
18 * Texts, Names, Instances, Classes, Types, Kinds and Modules
19 * ------------------------------------------------------------------------*/
21 extern Text textPrelude;
22 extern Text textNum; /* used to process default decls */
23 extern Text textCcall; /* used to process foreign import */
24 extern Text textStdcall; /* ... and foreign export */
25 extern Text textPlus; /* Used to recognise n+k patterns */
28 extern Name nameFalse, nameTrue;
29 extern Name nameNil, nameCons;
30 extern Name nameJust, nameNothing;
31 extern Name nameLeft, nameRight;
33 extern Name nameLT, nameEQ;
35 extern Name nameFst, nameSnd; /* standard combinators */
36 extern Name nameId, nameOtherwise;
37 extern Name nameNegate, nameFlip; /* primitives reqd for parsing */
38 extern Name nameFrom, nameFromThen;
39 extern Name nameFromTo, nameFromThenTo;
40 extern Name nameFatbar, nameFail; /* primitives reqd for translation */
41 extern Name nameIf, nameSel;
42 extern Name nameCompAux;
43 extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
44 extern Name namePmInteger;
45 extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */
46 extern Name nameError; /* For runtime error messages */
47 extern Name nameUndefined; /* A generic undefined value */
48 extern Name nameBlackHole; /* For GC-detected black hole */
49 extern Name nameInd; /* For dict indirection */
50 extern Name nameAnd, nameOr; /* For optimisation of && and || */
51 extern Name nameFromInt, nameFromDouble;/*coercion of numerics */
52 extern Name nameFromInteger;
53 extern Name nameEq, nameCompare; /* names used for deriving */
54 extern Name nameMinBnd, nameMaxBnd;
55 extern Name nameIndex, nameInRange;
56 extern Name nameRange;
57 extern Name nameLe, nameGt;
58 extern Name nameShowsPrec, nameReadsPrec;
59 extern Name nameMult, namePlus;
60 extern Name nameComp, nameApp; /* composition and append */
61 extern Name nameShowField; /* display single field */
62 extern Name nameShowParen; /* wrap with parens */
63 extern Name nameReadField; /* read single field */
64 extern Name nameReadParen; /* unwrap from parens */
65 extern Name nameLex; /* lexer */
66 extern Name nameRangeSize; /* calculate size of index range */
67 extern Name nameReturn, nameBind; /* for translating monad comps */
68 extern Name nameMFail;
69 extern Name nameListMonad; /* builder function for List Monad */
70 extern Name namePrint; /* printing primitive */
71 extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */
73 extern Name namePutStr;
74 extern Name nameRunIO_toplevel;
76 /* The following data constructors are used to make boxed but
77 * unpointed values pointed and require no special treatment
78 * by the code generator. */
79 extern Name nameMkInteger;
80 extern Name nameMkPrimArray;
81 extern Name nameMkPrimByteArray;
82 extern Name nameMkRef;
83 extern Name nameMkPrimMutableArray;
84 extern Name nameMkPrimMutableByteArray;
85 extern Name nameMkThreadId;
86 extern Name nameMkPrimMVar;
87 #ifdef PROVIDE_FOREIGN
88 extern Name nameMkForeign;
91 extern Name nameMkWeak;
94 /* The following data constructors are used to box unboxed
95 * arguments and are treated differently by the code generator.
96 * That is, they have primop `elem` {INT_REP,FLOAT_REP,...}. */
97 #define boxingConRep(con) ((AsmRep)(name(con).primop))
98 #define isBoxingCon(con) (isName(con) && boxingConRep(con) != 0)
105 extern Name nameMkStable;
107 /* used while desugaring */
109 extern Name nameOtherwise;
110 extern Name nameUndefined; /* generic undefined value */
112 /* used in pattern match */
113 extern Name namePmSub;
116 /* used in translation */
118 extern Name namePMFail;
119 extern Name nameEqChar;
120 extern Name nameEqInteger;
121 extern Name namePmInt;
122 extern Name namePmInteger;
123 extern Name namePmDouble;
124 extern Name namePmLe;
125 extern Name namePmSubtract;
126 extern Name namePmFromInteger;
127 extern Name nameMkIO;
128 extern Name nameUnpackString;
129 extern Name namePrimSeq;
131 extern Name nameMinus;
134 extern Class classMonad; /* Monads */
135 extern Class classEq; /* `standard' classes */
136 extern Class classOrd;
137 extern Class classShow;
138 extern Class classRead;
139 extern Class classIx;
140 extern Class classEnum;
141 extern Class classBounded;
142 extern Class classReal; /* `numeric' classes */
143 extern Class classIntegral;
144 extern Class classRealFrac;
145 extern Class classRealFloat;
146 extern Class classFractional;
147 extern Class classFloating;
148 extern Class classNum;
151 extern Type typeProgIO; /* For the IO monad, IO a */
152 extern Type typeArrow; /* Builtin type constructors */
153 extern Type typeList;
154 extern Type typeUnit;
155 extern Type typeInt64;
156 extern Type typeWord;
157 extern Type typeFloat;
158 extern Type typePrimArray;
159 extern Type typePrimByteArray;
161 extern Type typePrimMutableArray;
162 extern Type typePrimMutableByteArray;
163 extern Type typeStable;
164 extern Type typeWeak;
166 extern Type typeForeign;
167 extern Type typeMVar;
168 extern Type typeThreadId;
169 extern Type typeException;
172 extern Type typeOrdering;
173 extern List stdDefaults; /* List of standard default types */
175 /* For every primitive type provided by the runtime system,
176 * we construct a Haskell type using a declaration of the form:
178 * data Int -- no constructors given
180 extern Type typeChar;
182 extern Type typeInteger;
183 extern Type typeWord;
184 extern Type typeAddr;
185 extern Type typePrimArray;
186 extern Type typePrimByteArray;
188 extern Type typePrimMutableArray;
189 extern Type typePrimMutableByteArray;
190 extern Type typeFloat;
191 extern Type typeDouble;
192 extern Type typeStable;
193 extern Type typeThreadId;
194 extern Type typeMVar;
196 extern Type typeWeak;
198 #ifdef PROVIDE_FOREIGN
199 extern Type typeForeign;
202 /* And a smaller number of types defined in plain Haskell */
203 extern Type typeList;
204 extern Type typeUnit;
205 extern Type typeString;
206 extern Type typeBool;
209 extern Type typeException;
212 extern Module modulePrelude;
215 extern Kind starToStar; /* Type -> Type */
219 extern Name nameRecExt; /* Extend a record */
220 extern Name nameRecBrk; /* Break a record */
221 extern Name nameAddEv; /* Addition of evidence values */
222 extern Name nameRecSel; /* Select a record */
223 extern Name nameRecShw; /* Show a record */
224 extern Name nameShowRecRow; /* Used to output rows */
225 extern Name nameRecEq; /* Compare records */
226 extern Name nameEqRecRow; /* Used to compare rows */
227 extern Name nameInsFld; /* Field insertion routine */
228 extern Name nameNoRec; /* The empty record */
229 extern Type typeNoRow; /* The empty row */
230 extern Type typeRec; /* Record formation */
231 extern Kind extKind; /* Kind of extension, *->row->row */
235 /* --------------------------------------------------------------------------
236 * Constructions from the above names, types, etc.
237 * ------------------------------------------------------------------------*/
240 extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
241 extern Type listof; /* [ mkOffset(0) ] */
242 extern Cell predNum; /* Num (mkOffset(0)) */
243 extern Cell predFractional; /* Fractional (mkOffset(0)) */
244 extern Cell predIntegral; /* Integral (mkOffset(0)) */
245 extern Cell predMonad; /* Monad (mkOffset(0)) */
247 extern Type arrow; /* mkOffset(0) -> mkOffset(1) */
248 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
249 extern Type listof; /* [ mkOffset(0) ] */
250 extern Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */
252 extern Cell predNum; /* Num (mkOffset(0)) */
253 extern Cell predFractional; /* Fractional (mkOffset(0)) */
254 extern Cell predIntegral; /* Integral (mkOffset(0)) */
255 extern Kind starToStar; /* Type -> Type */
256 extern Cell predMonad; /* Monad (mkOffset(0)) */
258 #define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */
260 #define aVar mkOffset(0) /* Simple skeleton for type var */
261 extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */
263 #define consChar(c) ap(nameCons,mkChar(c))
265 /* --------------------------------------------------------------------------
267 * ------------------------------------------------------------------------*/
269 extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
270 extern Bool combined; /* TRUE => combined operation */
271 extern Bool debugSC; /* TRUE => print SC to screen */
272 extern Bool kindExpert; /* TRUE => display kind errors in */
274 extern Bool allowOverlap; /* TRUE => allow overlapping insts */
276 extern String repeatStr; /* Repeat last command string */
277 extern String hugsEdit; /* String for editor command */
278 extern String hugsPath; /* String for file search path */
279 extern String projectPath; /* String for project search path */
281 extern Cell* CStackBase; /* pointer to base of C stack */
283 extern List tyconDefns; /* list of type constructor defns */
284 extern List typeInDefns; /* list of synonym restrictions */
285 extern List valDefns; /* list of value definitions */
286 extern List classDefns; /* list of class definitions */
287 extern List instDefns; /* list of instance definitions */
288 extern List selDefns; /* list of selector lists */
289 extern List genDefns; /* list of generated defns */
290 extern List primDefns; /* list of primitive definitions */
291 extern List unqualImports; /* unqualified import list */
292 extern List defaultDefns; /* default definitions (if any) */
293 extern Int defaultLine; /* line in which default defs occur*/
294 extern List evalDefaults; /* defaults for evaluator */
295 extern Cell inputExpr; /* evaluator input expression */
296 extern Cell inputContext; /* evaluator input expression */
298 extern Cell whnfHead; /* head of term in whnf */
299 extern Int whnfInt; /* integer value of term in whnf */
300 extern Float whnfFloat; /* float value of term in whnf */
301 extern Long numCells; /* number of cells allocated */
302 extern Int numGcs; /* number of garbage collections */
303 extern Bool broken; /* indicates interrupt received */
304 extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
306 extern Bool gcMessages; /* TRUE => print GC messages */
307 extern Bool literateScripts; /* TRUE => default lit scripts */
308 extern Bool literateErrors; /* TRUE => report errs in lit scrs */
309 extern Bool showInstRes; /*TRUE => show instance resolution */
311 extern Int cutoff; /* Constraint Cutoff depth */
313 extern List diVars; /* deriving: cache of names */
314 extern Int diNum; /* also for deriving */
315 extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
318 extern String preprocessor; /* preprocessor command */
322 /* --------------------------------------------------------------------------
323 * Function prototypes etc...
324 * ------------------------------------------------------------------------*/
328 #define RESET 1 /* reset subsystem */
329 #define MARK 2 /* mark parts of graph in use by subsystem */
330 #define PREPREL 3 /* do startup actions before Prelude loading */
331 #define POSTPREL 4 /* do startup actions after Prelude loading */
332 #define EXIT 5 /* Take action immediately before exit() */
333 #define BREAK 6 /* Take action after program break */
334 #define GCDONE 7 /* Restore subsystem invariants after GC */
336 /* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy
339 extern Void everybody ( Int );
340 extern Void linkControl ( Int );
341 extern Void deriveControl ( Int );
342 extern Void translateControl ( Int );
343 extern Void codegen ( Int );
344 extern Void machdep ( Int );
345 extern Void liftControl ( Int );
346 extern Void substitution ( Int );
347 extern Void typeChecker ( Int );
348 extern Void interface ( Int );
349 extern Void storage ( Int );
354 extern Void setGoal ( String, Target );
355 extern Void soFar ( Target );
356 extern Void done ( Void );
357 extern String fromEnv ( String,String );
358 extern Bool chase ( List );
360 extern Void input ( Int );
361 extern Void consoleInput ( String );
362 extern Void projInput ( String );
363 extern Void stringInput ( String );
364 extern Void parseScript ( String,Long );
365 extern Void parseExp ( Void );
366 #if EXPLAIN_INSTANCE_RESOLUTION
367 extern Void parseContext ( Void );
369 extern String readFilename ( Void );
370 extern String readLine ( Void );
371 extern Syntax defaultSyntax ( Text );
372 extern Syntax syntaxOf ( Name );
373 extern String unlexChar ( Char,Char );
374 extern Void printString ( String );
377 extern Void staticAnalysis ( Int );
378 extern Void startModule ( Cell );
379 extern Void setExportList ( List );
380 extern Void setExports ( List );
381 extern Void addQualImport ( Text,Text );
382 extern Void addUnqualImport ( Text,List );
384 extern Void tyconDefn ( Int,Cell,Cell,Cell );
385 extern Void setTypeIns ( List );
386 extern Void clearTypeIns ( Void );
387 extern Type fullExpand ( Type );
388 extern Bool isAmbiguous ( Type );
389 extern Void ambigError ( Int,String,Cell,Type );
390 extern Void classDefn ( Int,Cell,List,List );
391 extern Void instDefn ( Int,Cell,Cell );
392 extern Void addTupInst ( Class,Int );
393 extern Name newDSel ( Class,Int );
395 extern Inst addRecShowInst ( Class,Ext );
396 extern Inst addRecEqInst ( Class,Ext );
398 extern List offsetTyvarsIn ( Type,List );
401 extern List typeVarsIn ( Cell,List,List,List );
402 extern List oclose ( List,List );
403 extern List zonkTyvarsIn ( Type,List );
404 extern Type zonkTyvar ( Int );
405 extern Type zonkType ( Type,Int );
406 extern Void primDefn ( Cell,List,Cell );
407 extern Void defaultDefn ( Int,List );
408 extern Void checkExp ( Void );
409 extern Type conToTagType ( Tycon );
410 extern Type tagToConType ( Tycon );
411 extern Int visitClass ( Class );
413 #if EXPLAIN_INSTANCE_RESOLUTION
414 extern Void checkContext ( Void );
416 extern Void checkDefns ( Void );
417 extern Bool h98Pred ( Bool,Cell );
418 extern Cell h98Context ( Bool,List );
419 extern Void h98CheckCtxt ( Int,String,Bool,List,Inst );
420 extern Void h98CheckType ( Int,String,Cell,Type );
421 extern Void h98DoesntSupport ( Int,String );
423 extern Int userArity ( Name );
424 extern List deriveEq ( Tycon );
425 extern List deriveOrd ( Tycon );
426 extern List deriveEnum ( Tycon );
427 extern List deriveIx ( Tycon );
428 extern List deriveShow ( Tycon );
429 extern List deriveRead ( Cell );
430 extern List deriveBounded ( Tycon );
431 extern List checkPrimDefn ( Triple );
433 extern Void foreignImport ( Cell,Text,Pair,Cell,Cell );
434 extern Void foreignExport ( Cell,Text,Cell,Cell,Cell );
436 extern Void implementForeignImport ( Name );
437 extern Void implementForeignExport ( Name );
439 extern List foreignExports; /* foreign export declarations */
440 extern List foreignImports; /* foreign import declarations */
442 extern Type primType ( Int /*AsmMonad*/ monad,
443 String a_kinds, String r_kinds );
445 extern Type typeCheckExp ( Bool );
446 extern Void typeCheckDefns ( Void );
447 extern Cell provePred ( Kinds,List,Cell );
448 extern List simpleContext ( List,Int );
449 extern Cell rhsExpr ( Cell );
450 extern Int rhsLine ( Cell );
451 extern Bool isProgType ( List,Type );
452 extern Cell superEvid ( Cell,Class,Class );
453 extern Void linkPreludeTC ( Void );
454 extern Void linkPreludeCM ( Void );
455 extern Void linkPrimNames ( Void );
457 extern Void compiler ( Int );
458 extern Void compileDefns ( Void );
459 extern Void compileExp ( Void );
460 extern Bool failFree ( Cell );
461 extern Int discrArity ( Cell );
463 extern Addr codeGen ( Name,Int,Cell );
464 extern Void evalExp ( Void );
465 extern Int shellEsc ( String );
466 extern Int getTerminalWidth ( Void );
467 extern Void normalTerminal ( Void );
468 extern Void noechoTerminal ( Void );
469 extern Int readTerminalChar ( Void );
470 extern Void gcStarted ( Void );
471 extern Void gcScanning ( Void );
472 extern Void gcRecovered ( Int );
473 extern Void gcCStack ( Void );
474 extern Void needPrims ( Int );
475 extern List calcFunDepsPreds ( List );
476 extern Inst findInstFor ( Cell,Int );
478 extern List findInstsFor ( Cell,Int );
482 /*---------------------------------------------------------------------------
483 * Debugging printers, and output-ery
484 *-------------------------------------------------------------------------*/
486 extern Void ppScripts ( Void );
487 extern Void ppModules ( Void );
489 extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
491 extern Void ppStg ( Cell /*StgVar*/ v );
492 extern Void ppStgExpr ( Cell /*StgExpr*/ e );
493 extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
494 extern Void ppStgAlts ( List alts );
495 extern Void ppStgPrimAlts ( List alts );
496 extern Void ppStgVars ( List vs );
498 extern Void putChr ( Int );
499 extern Void putStr ( String );
500 extern Void putInt ( Int );
501 extern Void putPtr ( Ptr );
503 extern Void unlexCharConst ( Cell );
504 extern Void unlexStrConst ( Text );
505 extern Void unlexVar ( Text );
506 extern Void unlexVarStr ( String );
508 extern FILE *outputStream; /* current output stream */
509 extern Int outColumn; /* current output column number */
513 /*---------------------------------------------------------------------------
514 * Crude profiling (probably doesn't work)
515 *-------------------------------------------------------------------------*/
517 #ifdef CRUDE_PROFILING
518 extern void cp_init ( void );
519 extern void cp_enter ( Cell /*StgVar*/ );
520 extern void cp_bill_words ( int );
521 extern void cp_bill_insns ( int );
522 extern void cp_show ( void );
526 /*---------------------------------------------------------------------------
527 * For dynamic.c and general object-related stuff
528 *-------------------------------------------------------------------------*/
530 extern void* getDLLSymbol ( Int,String,String );
531 extern Bool stdcallAllowed ( void );
533 #if LEADING_UNDERSCORE
534 #define MAYBE_LEADING_UNDERSCORE(sss) _##sss
535 #define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
537 #define MAYBE_LEADING_UNDERSCORE(sss) sss
538 #define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
542 /*---------------------------------------------------------------------------
543 * Interrupting execution (signals, allowBreak):
544 *-------------------------------------------------------------------------*/
546 extern Bool breakOn ( Bool );
547 extern Bool broken; /* indicates interrupt received */
549 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
553 /* allowBreak: call to allow user to interrupt computation
554 * ctrlbrk: set control break handler
559 # define allowBreak() kbhit()
560 #else /* !HUGS_FOR_WINDOWS */
561 # if HAVE_SIGPROCMASK
563 # define ctrlbrk(bh) { sigset_t mask; \
565 sigemptyset(&mask); \
566 sigaddset(&mask, SIGINT); \
567 sigprocmask(SIG_UNBLOCK, &mask, NULL); \
570 # define ctrlbrk(bh) signal(SIGINT,bh)
573 extern int time_release;
574 extern int allow_break_count;
575 # define allowBreak() if (time_release !=0 && \
576 (++allow_break_count % time_release) == 0) \
579 # define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); }
581 #endif /* !HUGS_FOR_WINDOWS */
584 /*---------------------------------------------------------------------------
585 * Environment variables and the registry
586 *-------------------------------------------------------------------------*/
588 /* On Win32 we can use the registry to supplement info in environment
591 /* AJG: Commented out for now for development */
592 /* #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) */
595 Bool writeRegString ( String var, String val );
596 String readRegString ( String var, String def );
597 Int readRegInt ( String var, Int def );
598 Bool writeRegInt ( String var, Int val );
601 #define N_INSTALLDIR 200
602 extern char installDir[N_INSTALLDIR];
605 /*---------------------------------------------------------------------------
607 *-------------------------------------------------------------------------*/
610 # include <sys/types.h>
612 #elif !HUGS_FOR_WINDOWS
613 extern int chdir ( const char* );
619 extern int system ( const char * );
620 extern double atof ( const char * );
621 extern void exit ( int );
624 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
625 #define FILENAME_MAX 256
627 #if FILENAME_MAX < 256
629 #define FILENAME_MAX 256
633 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
634 #define DOS_FILENAMES HAVE_DOS_H
635 /* ToDo: can we replace this with a feature test? */
636 #define MAC_FILENAMES SYMANTEC_C
638 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
640 #if CASE_INSENSITIVE_FILENAMES
642 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
644 # define filenamecmp(s1,s2) _stricmp(s1,s2)
646 # define filenamecmp(s1,s2) stricmp(s1,s2)
648 # define filenamecmp(s1,s2) strcmpi(s1,s2)
651 # define filenamecmp(s1,s2) strcmp(s1,s2)
655 /*---------------------------------------------------------------------------
656 * Pipe-related operations:
658 * On Windows, many standard Unix names acquire a leading underscore.
659 * Irritating, but easy to work around.
660 *-------------------------------------------------------------------------*/
662 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
663 #define popen(x,y) _popen(x,y)
665 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
666 #define pclose(x) _pclose(x)
670 /*---------------------------------------------------------------------------
672 *-------------------------------------------------------------------------*/
674 #define bitArraySize(n) ((n)/bitsPerWord + 1)
675 #define placeInSet(n) ((-(n)-1)>>wordShift)
676 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
679 /*---------------------------------------------------------------------------
680 * Function prototypes for code in machdep.c
681 *-------------------------------------------------------------------------*/
683 extern String findMPathname ( String,String,String );
684 extern String findPathname ( String,String );
685 extern Int shellEsc ( String );
686 extern Int getTerminalWidth ( Void );
687 extern Void normalTerminal ( Void );
688 extern Void noechoTerminal ( Void );
689 extern Int readTerminalChar ( Void );
690 extern Void gcStarted ( Void );
691 extern Void gcScanning ( Void );
692 extern Void gcRecovered ( Int );
693 extern Void gcCStack ( Void );
696 /*---------------------------------------------------------------------------
697 * To do with reading interface and object files
698 *-------------------------------------------------------------------------*/
700 extern Cell parseInterface ( String,Long );
701 extern ZPair readInterface ( String,Long );
702 extern Bool processInterfaces ( Void );
703 extern Void getFileSize ( String, Long * );
704 extern Void ifLinkConstrItbl ( Name n );
705 extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
706 extern String getExtraObjectInfo ( String primaryObjectName,
707 String extraFileName,
708 Int* extraFileSize );
710 extern List /* of ZTriple(I_INTERFACE,
711 Text--name of obj file,
712 Int--size of obj file) */
716 /* --------------------------------------------------------------------------
717 * Interpreter command structure
718 * ------------------------------------------------------------------------*/
727 extern Command readCommand ( struct cmd *, Char, Char );
755 /* --------------------------------------------------------------------------
758 * Rhs -> STGCON (Con, [Atom])
759 * | STGAPP (Var, [Atom]) -- delayed application
762 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
763 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
764 * | CASE (Expr,[Alt]) -- algebraic case
765 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
766 * | STGPRIM (Prim,[Atom])
767 * | STGAPP (Var, [Atom]) -- tail call
768 * | Var -- Abbreviation for STGAPP(Var,[])
773 * | BIGNUM -- unboxed
778 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
779 * | Name -- let-bound (effectively)
780 * -- always unboxed (PTR_REP)
782 * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
783 * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
784 * -- Con is Name or TUPLE
785 * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
787 * We use pointer equality to distinguish variables.
788 * The info field of a Var is used as follows in various phases:
790 * Translation: unused (set to NIL on output)
791 * Freevar analysis: list of free vars after
792 * Lambda lifting: freevar list or UNIT on input, discarded after
793 * Code generation: unused
794 * Optimisation: number of uses (sort-of) of let-bound variable
795 * ------------------------------------------------------------------------*/
798 typedef Cell StgExpr;
799 typedef Cell StgAtom;
800 typedef Cell StgVar; /* Could be a Name or an STGVAR */
801 typedef Cell StgCaseAlt;
802 typedef Cell StgPrimAlt;
803 typedef Cell StgDiscr;
804 typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
806 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
807 #define stgLetBinds(e) fst(snd(e))
808 #define stgLetBody(e) snd(snd(e))
810 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
811 #define stgVarBody(e) fst3(snd(e))
812 #define stgVarRep(e) snd3(snd(e))
813 #define stgVarInfo(e) thd3(snd(e))
815 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
816 #define stgCaseScrut(e) fst(snd(e))
817 #define stgCaseAlts(e) snd(snd(e))
819 #define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e))
820 #define stgCaseAltCon(alt) fst3(snd(alt))
821 #define stgCaseAltVars(alt) snd3(snd(alt))
822 #define stgCaseAltBody(alt) thd3(snd(alt))
824 #define mkStgDefault(v,e) ap(DEEFALT,pair(v,e))
825 #define stgDefaultVar(alt) fst(snd(alt))
826 #define stgDefaultBody(alt) snd(snd(alt))
827 #define isDefaultAlt(alt) (fst(alt)==DEEFALT)
829 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
830 #define stgPrimCaseScrut(e) fst(snd(e))
831 #define stgPrimCaseAlts(e) snd(snd(e))
833 #define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
834 #define stgPrimAltVars(alt) fst(snd(alt))
835 #define stgPrimAltBody(alt) snd(snd(alt))
837 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
838 #define stgAppFun(e) fst(snd(e))
839 #define stgAppArgs(e) snd(snd(e))
841 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
842 #define stgPrimOp(e) fst(snd(e))
843 #define stgPrimArgs(e) snd(snd(e))
845 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
846 #define stgConCon(e) fst(snd(e))
847 #define stgConArgs(e) snd(snd(e))
849 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
850 #define stgLambdaArgs(e) fst(snd(e))
851 #define stgLambdaBody(e) snd(snd(e))
854 /* --------------------------------------------------------------------------
855 * Utility functions for manipulating STG syntax trees.
856 * ------------------------------------------------------------------------*/
858 extern int stgConTag ( StgDiscr d );
859 extern void* stgConInfo ( StgDiscr d );
860 extern int stgDiscrTag ( StgDiscr d );
862 extern List makeArgs ( Int );
863 extern StgExpr makeStgLambda ( List args, StgExpr body );
864 extern StgExpr makeStgApp ( StgVar fun, List args );
865 extern StgExpr makeStgLet ( List binds, StgExpr body );
866 extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 );
867 extern Bool isStgVar ( StgRhs rhs );
868 extern Bool isAtomic ( StgRhs rhs );
869 extern StgVar mkStgVar ( StgRhs rhs, Cell info );
871 #define mkStgRep(c) mkChar(c)
874 /* --------------------------------------------------------------------------
875 * STG/backendish functions
876 * ------------------------------------------------------------------------*/
878 extern Void stgDefn ( Name n, Int arity, Cell e );
880 extern Void implementForeignImport ( Name );
881 extern Void implementForeignExport ( Name );
882 extern Void implementCfun ( Name, List );
883 extern Void implementConToTag ( Tycon );
884 extern Void implementTagToCon ( Tycon );
885 extern Void implementPrim ( Name );
886 extern Void implementTuple ( Int );
888 extern Name implementRecShw ( Text );
889 extern Name implementRecEq ( Text );
892 /* Association list storing globals assigned to dictionaries, tuples, etc */
893 extern List stgGlobals;
895 extern List liftBinds ( List binds );
896 extern StgExpr substExpr ( List sub, StgExpr e );
897 extern List freeVarsBind ( List, StgVar );
900 extern Void cgBinds ( StgRhs );
901 extern void* closureOfVar ( StgVar );
902 extern char* lookupHugsName ( void* );
905 /* --------------------------------------------------------------------------
906 * Definitions for substitution data structure and operations.
907 * ------------------------------------------------------------------------*/
909 typedef struct { /* Each type variable contains: */
910 Type bound; /* A type skeleton (unbound==NIL) */
911 Int offs; /* Offset for skeleton */
912 Kind kind; /* kind annotation */
915 #if FIXED_SUBST /* storage for type variables */
916 extern Tyvar tyvars[];
918 extern Tyvar *tyvars; /* storage for type variables */
920 extern Int typeOff; /* offset of result type */
921 extern Type typeIs; /* skeleton of result type */
922 extern Int typeFree; /* freedom in instantiated type */
923 extern List predsAre; /* list of predicates in type */
924 extern List genericVars; /* list of generic vars */
925 extern List btyvars; /* explicitly scoped type vars */
927 #define tyvar(n) (tyvars+(n)) /* nth type variable */
928 #define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
929 #define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
930 #define aVar mkOffset(0) /* Simple skeletons for type vars */
931 #define bVar mkOffset(1)
932 #define enterBtyvs() btyvars = cons(NIL,btyvars)
933 #define leaveBtyvs() btyvars = tl(btyvars)
935 #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
940 /* offs values when isNull(bound): */
941 #define FIXED_TYVAR 0 /* fixed in current assumption */
942 #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
943 #define GENERIC 2 /* GENERIC+n==nth generic var found*/
945 extern char *unifyFails; /* Unification error message */
947 extern Void emptySubstitution ( Void );
948 extern Int newTyvars ( Int );
949 #define newKindvars(n) newTyvars(n)
950 extern Int newKindedVars ( Kind );
951 extern Kind simpleKind ( Int );
952 extern Void instantiate ( Type );
954 extern Pair findBtyvs ( Text );
955 extern Void markBtyvs ( Void );
956 extern Type localizeBtyvs ( Type );
958 extern Tyvar *getTypeVar ( Type,Int );
959 extern Void tyvarType ( Int );
960 extern Void bindTv ( Int,Type,Int );
961 extern Cell getDerefHead ( Type,Int );
962 extern Void expandSyn ( Tycon, Int, Type *, Int * );
964 extern Void clearMarks ( Void );
965 extern Void markAllVars ( Void );
966 extern Void resetGenerics ( Void );
967 extern Void markTyvar ( Int );
968 extern Void markType ( Type,Int );
969 extern Void markPred ( Cell );
971 extern Type copyTyvar ( Int );
972 extern Type copyType ( Type,Int );
973 extern Cell copyPred ( Cell,Int );
974 extern Type dropRank2 ( Type,Int,Int );
975 extern Type dropRank1 ( Type,Int,Int );
976 extern Void liftRank2Args ( List,Int,Int );
977 extern Type liftRank2 ( Type,Int,Int );
978 extern Type liftRank1 ( Type,Int,Int );
980 extern Type debugTyvar ( Int );
981 extern Type debugType ( Type,Int );
983 extern Kind copyKindvar ( Int );
984 extern Kind copyKind ( Kind,Int );
986 extern Bool eqKind ( Kind,Kind );
987 extern Kind getKind ( Cell,Int );
989 extern List genvarTyvar ( Int,List );
990 extern List genvarType ( Type,Int,List );
992 extern Bool doesntOccurIn ( Tyvar*,Type,Int );
993 extern Bool unify ( Type,Int,Type,Int );
994 extern Bool kunify ( Kind,Int,Kind,Int );
996 extern Void typeTuple ( Cell );
997 extern Void varKind ( Int );
999 extern Bool samePred ( Cell,Int,Cell,Int );
1000 extern Bool matchPred ( Cell,Int,Cell,Int );
1001 extern Bool unifyPred ( Cell,Int,Cell,Int );
1002 extern Inst findInstFor ( Cell,Int );
1004 extern Void improve ( Int,List,List );
1005 extern Void improve1 ( Int,List,Cell,Int );
1007 extern Bool sameSchemes ( Type,Type );
1008 extern Bool sameType ( Type,Int,Type,Int );
1009 extern Bool matchType ( Type,Int,Type,Int );
1010 extern Bool typeMatches ( Type,Type );
1012 /*-------------------------------------------------------------------------*/