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/05/12 11:59:38 $
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 Text makeTypeDescrText ( Type );
455 extern Void implementForeignExport ( Name );
457 extern List foreignExports; /* foreign export declarations */
458 extern List foreignImports; /* foreign import declarations */
460 extern Type primType ( Int /*AsmMonad*/ monad,
461 String a_kinds, String r_kinds );
463 extern Type typeCheckExp ( Bool );
464 extern Void typeCheckDefns ( Void );
465 extern Cell provePred ( Kinds,List,Cell );
466 extern List simpleContext ( List,Int );
467 extern Cell rhsExpr ( Cell );
468 extern Int rhsLine ( Cell );
469 extern Bool isProgType ( List,Type );
470 extern Cell superEvid ( Cell,Class,Class );
471 extern Void linkPreludeTC ( Void );
472 extern Void linkPreludeCM ( Void );
473 extern Void linkPrimNames ( Void );
475 extern Void compiler ( Int );
476 extern Void compileDefns ( Void );
477 extern Void compileExp ( Void );
478 extern Bool failFree ( Cell );
479 extern Int discrArity ( Cell );
481 extern Addr codeGen ( Name,Int,Cell );
482 extern Void evalExp ( Void );
483 extern Int shellEsc ( String );
484 extern Int getTerminalWidth ( Void );
485 extern Void normalTerminal ( Void );
486 extern Void noechoTerminal ( Void );
487 extern Int readTerminalChar ( Void );
488 extern Void gcStarted ( Void );
489 extern Void gcScanning ( Void );
490 extern Void gcRecovered ( Int );
491 extern Void gcCStack ( Void );
492 extern Void needPrims ( Int );
493 extern List calcFunDepsPreds ( List );
494 extern Inst findInstFor ( Cell,Int );
496 extern List findInstsFor ( Cell,Int );
500 /*---------------------------------------------------------------------------
501 * Debugging printers, and output-ery
502 *-------------------------------------------------------------------------*/
504 extern Void ppScripts ( Void );
505 extern Void ppModules ( Void );
507 extern Void printStg ( FILE *fp, Cell /*StgVar*/ b);
509 extern Void ppStg ( Cell /*StgVar*/ v );
510 extern Void ppStgExpr ( Cell /*StgExpr*/ e );
511 extern Void ppStgRhs ( Cell /*StgRhs*/ rhs );
512 extern Void ppStgAlts ( List alts );
513 extern Void ppStgPrimAlts ( List alts );
514 extern Void ppStgVars ( List vs );
516 extern Void putChr ( Int );
517 extern Void putStr ( String );
518 extern Void putInt ( Int );
519 extern Void putPtr ( Ptr );
521 extern Void unlexCharConst ( Cell );
522 extern Void unlexStrConst ( Text );
523 extern Void unlexVar ( Text );
524 extern Void unlexVarStr ( String );
526 extern FILE *outputStream; /* current output stream */
527 extern Int outColumn; /* current output column number */
530 /*---------------------------------------------------------------------------
531 * For dynamic.c and general object-related stuff
532 *-------------------------------------------------------------------------*/
534 extern void* getDLLSymbol ( Int,String,String );
535 extern Bool stdcallAllowed ( void );
537 #if LEADING_UNDERSCORE
538 #define MAYBE_LEADING_UNDERSCORE(sss) _##sss
539 #define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
541 #define MAYBE_LEADING_UNDERSCORE(sss) sss
542 #define MAYBE_LEADING_UNDERSCORE_STR(sss) sss
546 /*---------------------------------------------------------------------------
547 * Interrupting execution (signals, allowBreak):
548 *-------------------------------------------------------------------------*/
551 enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt }
554 extern HugsBreakAction currentBreakAction;
555 extern HugsBreakAction setBreakAction ( HugsBreakAction );
558 #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */
562 /* ctrlbrk: set the interrupt handler.
563 Hugs relies on being able to do sigprocmask, since some of
564 the signal handlers do longjmps, and this zaps the previous
565 signal mask. So setHandler needs to do sigprocmask in order
566 to get the signal mask to a sane state each time.
569 #define setHandler(bh) { sigset_t mask; \
571 sigemptyset(&mask); \
572 sigaddset(&mask, SIGINT); \
573 sigprocmask(SIG_UNBLOCK, &mask, NULL); \
577 /*---------------------------------------------------------------------------
578 * Environment variables and the registry
579 *-------------------------------------------------------------------------*/
581 #define N_INSTALLDIR 200
582 extern char installDir[N_INSTALLDIR];
585 /*---------------------------------------------------------------------------
587 *-------------------------------------------------------------------------*/
590 # include <sys/types.h>
594 extern int chdir ( const char* );
599 extern int system ( const char * );
600 extern double atof ( const char * );
601 extern void exit ( int );
604 #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/
605 #define FILENAME_MAX 256
607 #if FILENAME_MAX < 256
609 #define FILENAME_MAX 256
613 /* Hack, hack: if you have dos.h, you probably have a DOS filesystem */
614 #define DOS_FILENAMES HAVE_DOS_H
615 /* ToDo: can we replace this with a feature test? */
616 #define MAC_FILENAMES SYMANTEC_C
618 #define CASE_INSENSITIVE_FILENAMES (DOS_FILENAMES | RISCOS)
620 #if CASE_INSENSITIVE_FILENAMES
622 # define filenamecmp(s1,s2) strcasecmp(s1,s2)
624 # define filenamecmp(s1,s2) _stricmp(s1,s2)
626 # define filenamecmp(s1,s2) stricmp(s1,s2)
628 # define filenamecmp(s1,s2) strcmpi(s1,s2)
631 # define filenamecmp(s1,s2) strcmp(s1,s2)
634 #define HI_ENDING ".u_hi"
637 /*---------------------------------------------------------------------------
638 * Pipe-related operations:
640 * On Windows, many standard Unix names acquire a leading underscore.
641 * Irritating, but easy to work around.
642 *-------------------------------------------------------------------------*/
644 #if !defined(HAVE_POPEN) && defined(HAVE__POPEN)
645 #define popen(x,y) _popen(x,y)
647 #if !defined(HAVE_PCLOSE) && defined(HAVE__PCLOSE)
648 #define pclose(x) _pclose(x)
652 /*---------------------------------------------------------------------------
654 *-------------------------------------------------------------------------*/
656 #define bitArraySize(n) ((n)/bitsPerWord + 1)
657 #define placeInSet(n) ((-(n)-1)>>wordShift)
658 #define maskInSet(n) (1<<((-(n)-1)&wordMask))
661 /*---------------------------------------------------------------------------
662 * Function prototypes for code in machdep.c
663 *-------------------------------------------------------------------------*/
665 extern String findMPathname ( String,String,String );
666 extern String findPathname ( String,String );
667 extern Int shellEsc ( String );
668 extern Int getTerminalWidth ( Void );
669 extern Void normalTerminal ( Void );
670 extern Void noechoTerminal ( Void );
671 extern Int readTerminalChar ( Void );
672 extern Void gcStarted ( Void );
673 extern Void gcScanning ( Void );
674 extern Void gcRecovered ( Int );
675 extern Void gcCStack ( Void );
678 /*---------------------------------------------------------------------------
679 * To do with reading interface and object files
680 *-------------------------------------------------------------------------*/
682 extern Cell parseInterface ( String,Long );
683 extern List getInterfaceImports ( Cell );
684 extern void processInterfaces ( List );
685 extern Void getFileSize ( String, Long * );
686 extern Void ifLinkConstrItbl ( Name n );
687 extern Void hi_o_namesFromSrcName ( String,String*,String* oName );
688 extern void* lookupObjName ( char* );
690 extern String getExtraObjectInfo ( String primaryObjectName,
691 String extraFileName,
692 Int* extraFileSize );
694 extern List /* of ZTriple(I_INTERFACE,
695 Text--name of obj file,
696 Int--size of obj file) */
700 /* --------------------------------------------------------------------------
701 * Interpreter command structure
702 * ------------------------------------------------------------------------*/
711 extern Command readCommand ( struct cmd *, Char, Char );
739 /* --------------------------------------------------------------------------
742 * Rhs -> STGCON (Con, [Atom])
743 * | STGAPP (Var, [Atom]) -- delayed application
746 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
747 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
748 * | CASE (Expr,[Alt]) -- algebraic case
749 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
750 * | STGPRIM (Prim,[Atom])
751 * | STGAPP (Var, [Atom]) -- tail call
752 * | Var -- Abbreviation for STGAPP(Var,[])
757 * | BIGNUM -- unboxed
762 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
763 * | Name -- let-bound (effectively)
764 * -- always unboxed (PTR_REP)
766 * Alt -> DEEFALT (Var,Expr) -- var bound to NIL
767 * | CASEALT (Con,[Var],Expr) -- vars bound to NIL;
768 * -- Con is Name or TUPLE
769 * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int
771 * We use pointer equality to distinguish variables.
772 * The info field of a Var is used as follows in various phases:
774 * Translation: unused (set to NIL on output)
775 * Freevar analysis: list of free vars after
776 * Lambda lifting: freevar list or UNIT on input, discarded after
777 * Code generation: unused
778 * ------------------------------------------------------------------------*/
781 typedef Cell StgExpr;
782 typedef Cell StgAtom;
783 typedef Cell StgVar; /* Could be a Name or an STGVAR */
784 typedef Cell StgCaseAlt;
785 typedef Cell StgPrimAlt;
786 typedef Cell StgDiscr;
787 typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
789 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
790 #define stgLetBinds(e) fst(snd(e))
791 #define stgLetBody(e) snd(snd(e))
793 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
794 #define stgVarBody(e) fst3(snd(e))
795 #define stgVarRep(e) snd3(snd(e))
796 #define stgVarInfo(e) thd3(snd(e))
798 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
799 #define stgCaseScrut(e) fst(snd(e))
800 #define stgCaseAlts(e) snd(snd(e))
802 #define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e))
803 #define stgCaseAltCon(alt) fst3(snd(alt))
804 #define stgCaseAltVars(alt) snd3(snd(alt))
805 #define stgCaseAltBody(alt) thd3(snd(alt))
807 #define mkStgDefault(v,e) ap(DEEFALT,pair(v,e))
808 #define stgDefaultVar(alt) fst(snd(alt))
809 #define stgDefaultBody(alt) snd(snd(alt))
810 #define isDefaultAlt(alt) (fst(alt)==DEEFALT)
812 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
813 #define stgPrimCaseScrut(e) fst(snd(e))
814 #define stgPrimCaseAlts(e) snd(snd(e))
816 #define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
817 #define stgPrimAltVars(alt) fst(snd(alt))
818 #define stgPrimAltBody(alt) snd(snd(alt))
820 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
821 #define stgAppFun(e) fst(snd(e))
822 #define stgAppArgs(e) snd(snd(e))
824 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
825 #define stgPrimOp(e) fst(snd(e))
826 #define stgPrimArgs(e) snd(snd(e))
828 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
829 #define stgConCon(e) fst(snd(e))
830 #define stgConArgs(e) snd(snd(e))
832 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
833 #define stgLambdaArgs(e) fst(snd(e))
834 #define stgLambdaBody(e) snd(snd(e))
837 /* --------------------------------------------------------------------------
838 * Utility functions for manipulating STG syntax trees.
839 * ------------------------------------------------------------------------*/
841 extern int stgConTag ( StgDiscr d );
842 extern void* stgConInfo ( StgDiscr d );
843 extern int stgDiscrTag ( StgDiscr d );
845 extern List makeArgs ( Int );
846 extern StgExpr makeStgLambda ( List args, StgExpr body );
847 extern StgExpr makeStgApp ( StgVar fun, List args );
848 extern StgExpr makeStgLet ( List binds, StgExpr body );
849 extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 );
850 extern Bool isStgVar ( StgRhs rhs );
851 extern Bool isAtomic ( StgRhs rhs );
852 extern StgVar mkStgVar ( StgRhs rhs, Cell info );
854 #define mkStgRep(c) mkChar(c)
857 /* --------------------------------------------------------------------------
858 * STG/backendish functions
859 * ------------------------------------------------------------------------*/
861 extern Void stgDefn ( Name n, Int arity, Cell e );
863 extern Void implementForeignImport ( Name );
864 extern Void implementForeignExport ( Name );
865 extern Void implementCfun ( Name, List );
866 extern Void implementConToTag ( Tycon );
867 extern Void implementTagToCon ( Tycon );
868 extern Void implementPrim ( Name );
869 extern Void implementTuple ( Int );
871 extern Name implementRecShw ( Text );
872 extern Name implementRecEq ( Text );
875 extern void liftModule ( Module );
876 extern StgExpr substExpr ( List sub, StgExpr e );
877 extern List freeVarsBind ( List, StgVar );
880 extern Void cgModule ( Module );
881 extern char* lookupHugsName ( void* );
884 /* --------------------------------------------------------------------------
885 * Definitions for substitution data structure and operations.
886 * ------------------------------------------------------------------------*/
888 typedef struct { /* Each type variable contains: */
889 Type bound; /* A type skeleton (unbound==NIL) */
890 Int offs; /* Offset for skeleton */
891 Kind kind; /* kind annotation */
894 extern Tyvar *tyvars; /* storage for type variables */
895 extern Int typeOff; /* offset of result type */
896 extern Type typeIs; /* skeleton of result type */
897 extern Int typeFree; /* freedom in instantiated type */
898 extern List predsAre; /* list of predicates in type */
899 extern List genericVars; /* list of generic vars */
900 extern List btyvars; /* explicitly scoped type vars */
902 #define tyvar(n) (tyvars+(n)) /* nth type variable */
903 #define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */
904 #define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM))
905 #define aVar mkOffset(0) /* Simple skeletons for type vars */
906 #define bVar mkOffset(1)
907 #define enterBtyvs() btyvars = cons(NIL,btyvars)
908 #define leaveBtyvs() btyvars = tl(btyvars)
910 #define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \
915 /* offs values when isNull(bound): */
916 #define FIXED_TYVAR 0 /* fixed in current assumption */
917 #define UNUSED_GENERIC 1 /* not fixed, not yet encountered */
918 #define GENERIC 2 /* GENERIC+n==nth generic var found*/
920 extern char *unifyFails; /* Unification error message */
922 extern Void emptySubstitution ( Void );
923 extern Int newTyvars ( Int );
924 #define newKindvars(n) newTyvars(n)
925 extern Int newKindedVars ( Kind );
926 extern Kind simpleKind ( Int );
927 extern Void instantiate ( Type );
929 extern Pair findBtyvs ( Text );
930 extern Void markBtyvs ( Void );
931 extern Type localizeBtyvs ( Type );
933 extern Tyvar *getTypeVar ( Type,Int );
934 extern Void tyvarType ( Int );
935 extern Void bindTv ( Int,Type,Int );
936 extern Cell getDerefHead ( Type,Int );
937 extern Void expandSyn ( Tycon, Int, Type *, Int * );
939 extern Void clearMarks ( Void );
940 extern Void markAllVars ( Void );
941 extern Void resetGenerics ( Void );
942 extern Void markTyvar ( Int );
943 extern Void markType ( Type,Int );
944 extern Void markPred ( Cell );
946 extern Type copyTyvar ( Int );
947 extern Type copyType ( Type,Int );
948 extern Cell copyPred ( Cell,Int );
949 extern Type dropRank2 ( Type,Int,Int );
950 extern Type dropRank1 ( Type,Int,Int );
951 extern Void liftRank2Args ( List,Int,Int );
952 extern Type liftRank2 ( Type,Int,Int );
953 extern Type liftRank1 ( Type,Int,Int );
955 extern Type debugTyvar ( Int );
956 extern Type debugType ( Type,Int );
958 extern Kind copyKindvar ( Int );
959 extern Kind copyKind ( Kind,Int );
961 extern Bool eqKind ( Kind,Kind );
962 extern Kind getKind ( Cell,Int );
964 extern List genvarTyvar ( Int,List );
965 extern List genvarType ( Type,Int,List );
967 extern Bool doesntOccurIn ( Tyvar*,Type,Int );
968 extern Bool unify ( Type,Int,Type,Int );
969 extern Bool kunify ( Kind,Int,Kind,Int );
971 extern Void typeTuple ( Cell );
972 extern Void varKind ( Int );
974 extern Bool samePred ( Cell,Int,Cell,Int );
975 extern Bool matchPred ( Cell,Int,Cell,Int );
976 extern Bool unifyPred ( Cell,Int,Cell,Int );
977 extern Inst findInstFor ( Cell,Int );
979 extern Void improve ( Int,List,List );
980 extern Void improve1 ( Int,List,Cell,Int );
982 extern Bool sameSchemes ( Type,Type );
983 extern Bool sameType ( Type,Int,Type,Int );
984 extern Bool matchType ( Type,Int,Type,Int );
985 extern Bool typeMatches ( Type,Type );
988 extern Void checkBytecodeCount ( Void );
990 /*-------------------------------------------------------------------------*/