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