X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fconnect.h;h=3fe465806c55829c4766970d501c74490d314a14;hb=668e01197062f70f91488345852c354d1abb5039;hp=5d3f0979870d380763cfddc0b2744c7a64db661b;hpb=170d1670295c7cb9731f8d0eb034cf21f3e613ee;p=ghc-hetmet.git diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index 5d3f097..3fe4658 100644 --- a/ghc/interpreter/connect.h +++ b/ghc/interpreter/connect.h @@ -1,3 +1,4 @@ + /* -------------------------------------------------------------------------- * Connections between components of the Hugs system * @@ -8,27 +9,28 @@ * included in the distribution. * * $RCSfile: connect.h,v $ - * $Revision: 1.11 $ - * $Date: 1999/10/16 02:17:30 $ + * $Revision: 1.39 $ + * $Date: 2000/04/25 17:43:49 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- - * Standard data: + * Connections to Prelude entities: + * Texts, Names, Instances, Classes, Types, Kinds and Modules * ------------------------------------------------------------------------*/ -extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/ -extern Module modulePrelude; +extern Text textPrelPrim; +extern Text textPrelude; +extern Text textNum; /* used to process default decls */ +extern Text textCcall; /* used to process foreign import */ +extern Text textStdcall; /* ... and foreign export */ +extern Text textPlus; /* Used to recognise n+k patterns */ -/* -------------------------------------------------------------------------- - * Primitive constructor functions - * ------------------------------------------------------------------------*/ extern Name nameFalse, nameTrue; extern Name nameNil, nameCons; extern Name nameJust, nameNothing; extern Name nameLeft, nameRight; extern Name nameUnit; - extern Name nameLT, nameEQ; extern Name nameGT; extern Name nameFst, nameSnd; /* standard combinators */ @@ -41,9 +43,7 @@ extern Name nameIf, nameSel; extern Name nameCompAux; extern Name namePmInt, namePmFlt; /* primitives for pattern matching */ extern Name namePmInteger; -#if NPLUSK extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */ -#endif extern Name nameError; /* For runtime error messages */ extern Name nameUndefined; /* A generic undefined value */ extern Name nameBlackHole; /* For GC-detected black hole */ @@ -58,11 +58,6 @@ extern Name nameRange; extern Name nameLe, nameGt; extern Name nameShowsPrec, nameReadsPrec; extern Name nameMult, namePlus; -extern Name nameConCmp, nameEnRange; -extern Name nameEnIndex, nameEnInRng; -extern Name nameEnToEn, nameEnFrEn; -extern Name nameEnFrom, nameEnFrTh; -extern Name nameEnFrTo; extern Name nameComp, nameApp; /* composition and append */ extern Name nameShowField; /* display single field */ extern Name nameShowParen; /* wrap with parens */ @@ -70,46 +65,86 @@ extern Name nameReadField; /* read single field */ extern Name nameReadParen; /* unwrap from parens */ extern Name nameLex; /* lexer */ extern Name nameRangeSize; /* calculate size of index range */ -extern Class classMonad; /* Monads */ extern Name nameReturn, nameBind; /* for translating monad comps */ extern Name nameMFail; extern Name nameListMonad; /* builder function for List Monad */ extern Name namePrint; /* printing primitive */ extern Name nameCreateAdjThunk; /* f-x-dyn: create adjustor thunk */ -extern Text textPrelude; -extern Text textNum; /* used to process default decls */ -#if NPLUSK -extern Text textPlus; /* Used to recognise n+k patterns */ +extern Name nameShow; +extern Name namePutStr; +extern Name nameRunIO_toplevel; + +/* The following data constructors are used to make boxed but + * unpointed values pointed and require no special treatment + * by the code generator. */ +extern Name nameMkInteger; +extern Name nameMkPrimArray; +extern Name nameMkPrimByteArray; +extern Name nameMkRef; +extern Name nameMkPrimMutableArray; +extern Name nameMkPrimMutableByteArray; +extern Name nameMkThreadId; +extern Name nameMkPrimMVar; +#ifdef PROVIDE_FOREIGN +extern Name nameMkForeign; #endif -#if TREX -extern Name nameNoRec; /* The empty record */ -extern Type typeNoRow; /* The empty row */ -extern Type typeRec; /* Record formation */ -extern Kind extKind; /* Kind of extension, *->row->row */ -extern Name nameRecExt; /* Extend a record */ -extern Name nameRecBrk; /* Break a record */ -extern Name nameAddEv; /* Addition of evidence values */ -extern Name nameRecSel; /* Select a record */ -extern Name nameRecShw; /* Show a record */ -extern Name nameShowRecRow; /* Used to output rows */ -extern Name nameRecEq; /* Compare records */ -extern Name nameEqRecRow; /* Used to compare rows */ -extern Name nameInsFld; /* Field insertion routine */ +#ifdef PROVIDE_WEAK +extern Name nameMkWeak; #endif -extern String repeatStr; /* Repeat last command string */ -extern String hugsEdit; /* String for editor command */ -extern String hugsPath; /* String for file search path */ -extern String projectPath; /* String for project search path */ - -extern Type typeArrow; /* Builtin type constructors */ -extern Type typeList; -extern Type typeUnit; +/* The following data constructors are used to box unboxed + * arguments and are treated differently by the code generator. + * That is, they have primop `elem` {INT_REP,FLOAT_REP,...}. */ +#define boxingConRep(con) ((AsmRep)(name(con).primop)) +#define isBoxingCon(con) (isName(con) && boxingConRep(con) != 0) +extern Name nameMkC; +extern Name nameMkI; +extern Name nameMkW; +extern Name nameMkA; +extern Name nameMkF; +extern Name nameMkD; +extern Name nameMkStable; + +/* used while desugaring */ +extern Name nameId; +extern Name nameOtherwise; +extern Name nameUndefined; /* generic undefined value */ + +/* used in pattern match */ +extern Name namePmSub; +extern Name nameSel; + +/* used in translation */ +extern Name nameEq; +extern Name namePMFail; +extern Name nameEqChar; +extern Name nameEqInteger; +extern Name namePmInt; +extern Name namePmInteger; +extern Name namePmDouble; +extern Name namePmLe; +extern Name namePmSubtract; +extern Name namePmFromInteger; +extern Name nameMkIO; +extern Name nameUnpackString; +extern Name namePrimSeq; +extern Name nameMap; +extern Name nameMinus; + +/* assertion and exceptions */ +extern Name nameAssert; +extern Name nameAssertError; +extern Name nameTangleMessage; +extern Name nameIrrefutPatError; +extern Name nameNoMethodBindingError; +extern Name nameNonExhaustiveGuardsError; +extern Name namePatError; +extern Name nameRecSelError; +extern Name nameRecConError; +extern Name nameRecUpdError; -#define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */ - -extern List stdDefaults; /* List of standard default types */ +extern Class classMonad; /* Monads */ extern Class classEq; /* `standard' classes */ extern Class classOrd; extern Class classShow; @@ -117,7 +152,6 @@ extern Class classRead; extern Class classIx; extern Class classEnum; extern Class classBounded; - extern Class classReal; /* `numeric' classes */ extern Class classIntegral; extern Class classRealFrac; @@ -126,226 +160,440 @@ extern Class classFractional; extern Class classFloating; extern Class classNum; -extern Cell *CStackBase; /* pointer to base of C stack */ - -extern List tyconDefns; /* list of type constructor defns */ -extern List typeInDefns; /* list of synonym restrictions */ -extern List valDefns; /* list of value definitions */ -extern List classDefns; /* list of class definitions */ -extern List instDefns; /* list of instance definitions */ -extern List selDefns; /* list of selector lists */ -extern List genDefns; /* list of generated defns */ -extern List primDefns; /* list of primitive definitions */ -extern List unqualImports; /* unqualified import list */ -extern List defaultDefns; /* default definitions (if any) */ -extern Int defaultLine; /* line in which default defs occur*/ -extern List evalDefaults; /* defaults for evaluator */ -extern Cell inputExpr; /* evaluator input expression */ -extern Cell inputContext; /* evaluator input expression */ -extern Addr inputCode; /* Code for compiled input expr */ - -extern Int whnfArgs; /* number of args of term in whnf */ -extern Cell whnfHead; /* head of term in whnf */ -extern Int whnfInt; /* integer value of term in whnf */ -extern Float whnfFloat; /* float value of term in whnf */ -extern Long numCells; /* number of cells allocated */ -extern Int numGcs; /* number of garbage collections */ -extern Bool broken; /* indicates interrupt received */ -extern Bool preludeLoaded; /* TRUE => prelude has been loaded */ - -extern Bool gcMessages; /* TRUE => print GC messages */ -extern Bool literateScripts; /* TRUE => default lit scripts */ -extern Bool literateErrors; /* TRUE => report errs in lit scrs */ -extern Bool optimise; /* TRUE => simplify STG */ - -extern Int cutoff; /* Constraint Cutoff depth */ -#if USE_PREPROCESSOR -extern String preprocessor; /* preprocessor command */ -#endif +extern Type typeProgIO; /* For the IO monad, IO a */ +extern Type typeArrow; /* Builtin type constructors */ +extern Type typeList; +extern Type typeUnit; +extern Type typeInt64; +extern Type typeWord; +extern Type typeFloat; +extern Type typePrimArray; +extern Type typePrimByteArray; +extern Type typeRef; +extern Type typePrimMutableArray; +extern Type typePrimMutableByteArray; +extern Type typeStable; +extern Type typeWeak; +extern Type typeIO; +extern Type typeForeign; +extern Type typeMVar; +extern Type typeThreadId; +extern Type typeException; +extern Type typeIO; +extern Type typeST; +extern Type typeOrdering; +extern List stdDefaults; /* List of standard default types */ -#if DEBUG_CODE -extern Bool debugCode; /* TRUE => print G-code to screen */ +/* For every primitive type provided by the runtime system, + * we construct a Haskell type using a declaration of the form: + * + * data Int -- no constructors given + */ +extern Type typeChar; +extern Type typeInt; +extern Type typeInteger; +extern Type typeWord; +extern Type typeAddr; +extern Type typePrimArray; +extern Type typePrimByteArray; +extern Type typeRef; +extern Type typePrimMutableArray; +extern Type typePrimMutableByteArray; +extern Type typeFloat; +extern Type typeDouble; +extern Type typeStable; +extern Type typeThreadId; +extern Type typeMVar; +#ifdef PROVIDE_WEAK +extern Type typeWeak; #endif -#if DEBUG_SHOWSC -extern Bool debugSC; /* TRUE => print SC to screen */ -extern Void printSc Args((FILE*, Text, Int, Cell)); +#ifdef PROVIDE_FOREIGN +extern Type typeForeign; +#endif + +/* And a smaller number of types defined in plain Haskell */ +extern Type typeList; +extern Type typeUnit; +extern Type typeString; +extern Type typeBool; +extern Type typeST; +extern Type typeIO; +extern Type typeException; + +extern Module modulePrelPrim; +extern Module modulePrelude; + +extern Kind starToStar; /* Type -> Type */ + + +#if TREX +extern Name nameRecExt; /* Extend a record */ +extern Name nameRecBrk; /* Break a record */ +extern Name nameAddEv; /* Addition of evidence values */ +extern Name nameRecSel; /* Select a record */ +extern Name nameRecShw; /* Show a record */ +extern Name nameShowRecRow; /* Used to output rows */ +extern Name nameRecEq; /* Compare records */ +extern Name nameEqRecRow; /* Used to compare rows */ +extern Name nameInsFld; /* Field insertion routine */ +extern Name nameNoRec; /* The empty record */ +extern Type typeNoRow; /* The empty row */ +extern Type typeRec; /* Record formation */ +extern Kind extKind; /* Kind of extension, *->row->row */ #endif -extern Bool kindExpert; /* TRUE => display kind errors in */ + + +/* -------------------------------------------------------------------------- + * Constructions from the above names, types, etc. + * ------------------------------------------------------------------------*/ + + +extern Type arrow; /* mkOffset(0) -> mkOffset(1) */ +extern Type listof; /* [ mkOffset(0) ] */ +extern Cell predNum; /* Num (mkOffset(0)) */ +extern Cell predFractional; /* Fractional (mkOffset(0)) */ +extern Cell predIntegral; /* Integral (mkOffset(0)) */ +extern Cell predMonad; /* Monad (mkOffset(0)) */ + +extern Type arrow; /* mkOffset(0) -> mkOffset(1) */ +extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */ +extern Type listof; /* [ mkOffset(0) ] */ +extern Type typeVarToVar; /* mkOffset(0) -> mkOffset(0) */ + +extern Cell predNum; /* Num (mkOffset(0)) */ +extern Cell predFractional; /* Fractional (mkOffset(0)) */ +extern Cell predIntegral; /* Integral (mkOffset(0)) */ +extern Kind starToStar; /* Type -> Type */ +extern Cell predMonad; /* Monad (mkOffset(0)) */ + +#define fn(from,to) ap(ap(typeArrow,from),to) /* make type: from -> to */ + +#define aVar mkOffset(0) /* Simple skeleton for type var */ +extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */ + +#define consChar(c) ap(nameCons,mkChar(c)) + +/* -------------------------------------------------------------------------- + * Umm .... + * ------------------------------------------------------------------------*/ + +extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/ +extern Bool combined; /* TRUE => combined operation */ +extern Bool debugSC; /* TRUE => print SC to screen */ +extern Bool kindExpert; /* TRUE => display kind errors in */ /* full detail */ -extern Bool allowOverlap; /* TRUE => allow overlapping insts */ +extern Bool allowOverlap; /* TRUE => allow overlapping insts */ + +extern String repeatStr; /* Repeat last command string */ +extern String hugsEdit; /* String for editor command */ +extern String hugsPath; /* String for file search path */ +extern String projectPath; /* String for project search path */ + +extern Cell* CStackBase; /* pointer to base of C stack */ + +extern List tyconDefns; /* list of type constructor defns */ +extern List typeInDefns; /* list of synonym restrictions */ +extern List valDefns; /* list of value definitions */ +extern List classDefns; /* list of class definitions */ +extern List instDefns; /* list of instance definitions */ +extern List selDefns; /* list of selector lists */ +extern List genDefns; /* list of generated defns */ +extern List primDefns; /* list of primitive definitions */ +extern List unqualImports; /* unqualified import list */ +extern List defaultDefns; /* default definitions (if any) */ +extern Int defaultLine; /* line in which default defs occur*/ +extern List evalDefaults; /* defaults for evaluator */ +extern Cell inputExpr; /* evaluator input expression */ +extern Cell inputContext; /* evaluator input expression */ + +extern Cell whnfHead; /* head of term in whnf */ +extern Int whnfInt; /* integer value of term in whnf */ +extern Float whnfFloat; /* float value of term in whnf */ +extern Long numCells; /* number of cells allocated */ +extern Int numGcs; /* number of garbage collections */ +extern int numEnters; /* number of enters */ +extern Bool preludeLoaded; /* TRUE => prelude has been loaded */ +extern Bool flagAssert; /* TRUE => assert False causes + an assertion failure */ + +extern Bool gcMessages; /* TRUE => print GC messages */ +extern Bool literateScripts; /* TRUE => default lit scripts */ +extern Bool literateErrors; /* TRUE => report errs in lit scrs */ +extern Bool showInstRes; /*TRUE => show instance resolution */ + +extern Int cutoff; /* Constraint Cutoff depth */ + +extern List diVars; /* deriving: cache of names */ +extern Int diNum; /* also for deriving */ +extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */ + +extern Module moduleBeingParsed; /* so the parser (topModule) knows */ + + +#if USE_PREPROCESSOR +extern String preprocessor; /* preprocessor command */ +#endif + /* -------------------------------------------------------------------------- * Function prototypes etc... * ------------------------------------------------------------------------*/ -extern Void everybody Args((Int)); -#define RESET 1 /* reset subsystem */ -#define MARK 2 /* mark parts of graph in use by subsystem */ -#define INSTALL 3 /* install subsystem (executed once only) */ -#define EXIT 4 /* Take action immediately before exit() */ -#define BREAK 5 /* Take action after program break */ -#define GCDONE 6 /* Restore subsystem invariantss after GC */ + +#define RESET 1 /* reset subsystem */ +#define MARK 2 /* mark parts of graph in use by subsystem */ +#define PREPREL 3 /* do startup actions before Prelude loading */ +#define POSTPREL 4 /* do startup actions after Prelude loading */ +#define EXIT 5 /* Take action immediately before exit() */ +#define BREAK 6 /* Take action after program break */ +#define GCDONE 7 /* Restore subsystem invariants after GC */ + +/* PREPREL was formerly called INSTALL. POSTPREL doesn't have an analogy + in the old Hugs. +*/ +extern Void everybody ( Int ); +extern Void linkControl ( Int ); +extern Void deriveControl ( Int ); +extern Void translateControl ( Int ); +extern Void codegen ( Int ); +extern Void machdep ( Int ); +extern Void liftControl ( Int ); +extern Void substitution ( Int ); +extern Void typeChecker ( Int ); +extern Void interface ( Int ); +extern Void storage ( Int ); + + typedef long Target; -extern Void setGoal Args((String, Target)); -extern Void soFar Args((Target)); -extern Void done Args((Void)); -extern String fromEnv Args((String,String)); -extern Bool chase Args((List)); - -extern Void storage Args((Int)); - -extern Void input Args((Int)); -extern Void consoleInput Args((String)); -extern Void projInput Args((String)); -extern Void stringInput Args((String)); -extern Void parseScript Args((String,Long)); -extern Void parseExp Args((Void)); -extern Void parseContext Args((Void)); -extern String readFilename Args((Void)); -extern String readLine Args((Void)); -extern Syntax defaultSyntax Args((Text)); -extern Syntax syntaxOf Args((Name)); -extern String unlexChar Args((Char,Char)); -extern Void printString Args((String)); - -extern Void substitution Args((Int)); -extern Void optimiser Args((Int)); - -extern Void staticAnalysis Args((Int)); -extern Void startModule Args((Cell)); -extern Void setExportList Args((List)); -extern Void setExports Args((List)); -extern Void addQualImport Args((Text,Text)); -extern Void addUnqualImport Args((Text,List)); - -extern Void tyconDefn Args((Int,Cell,Cell,Cell)); -extern Void setTypeIns Args((List)); -extern Void clearTypeIns Args((Void)); -extern Type fullExpand Args((Type)); -extern Bool isAmbiguous Args((Type)); -extern Void ambigError Args((Int,String,Cell,Type)); -extern Void classDefn Args((Int,Cell,List,List)); -extern Void instDefn Args((Int,Cell,Cell)); -extern Void addTupInst Args((Class,Int)); -#if TREX -extern Inst addRecShowInst Args((Class,Ext)); -extern Inst addRecEqInst Args((Class,Ext)); +extern Void setGoal ( String, Target ); +extern Void soFar ( Target ); +extern Void done ( Void ); +extern String fromEnv ( String,String ); +extern Bool chase ( List ); + +extern Void input ( Int ); +extern Void consoleInput ( String ); +extern Void projInput ( String ); +extern Void stringInput ( String ); +extern Cell parseModule ( String,Long ); +extern Void parseExp ( Void ); +#if EXPLAIN_INSTANCE_RESOLUTION +extern Void parseContext ( Void ); #endif -extern List oclose Args((List,List)); -extern List zonkTyvarsIn Args((Type,List)); -extern Type zonkTyvar Args((Int)); -extern Type zonkType Args((Type,Int)); -extern Void primDefn Args((Cell,List,Cell)); -extern Void defaultDefn Args((Int,List)); -extern Void checkExp Args((Void)); -extern Void checkDefns Args((Void)); -extern Bool h98Pred Args((Bool,Cell)); -extern Cell h98Context Args((Bool,List)); -extern Void h98CheckCtxt Args((Int,String,Bool,List,Inst)); -extern Void h98CheckType Args((Int,String,Cell,Type)); -extern Void h98DoesntSupport Args((Int,String)); - -extern Void typeChecker Args((Int)); -extern Type typeCheckExp Args((Bool)); -extern Void typeCheckDefns Args((Void)); -extern Cell provePred Args((Kinds,List,Cell)); -extern List simpleContext Args((List,Int)); -extern Cell rhsExpr Args((Cell)); -extern Int rhsLine Args((Cell)); -extern Bool isProgType Args((List,Type)); -extern Cell superEvid Args((Cell,Class,Class)); -extern Void linkPreludeTC Args((Void)); -extern Void linkPreludeCM Args((Void)); - -extern Void compiler Args((Int)); -extern Void compileDefns Args((Void)); -extern Void compileExp Args((Void)); -extern Bool failFree Args((Cell)); -extern Int discrArity Args((Cell)); - -extern Addr codeGen Args((Name,Int,Cell)); -extern Void implementCfun Args((Name,List)); +extern String readFilename ( Void ); +extern String readLine ( Void ); +extern Syntax defaultSyntax ( Text ); +extern Syntax syntaxOf ( Name ); +extern String unlexChar ( Char,Char ); +extern Void printString ( String ); + + +extern Void staticAnalysis ( Int ); +extern Void startModule ( Module ); +extern Void setExportList ( List ); +extern Void setExports ( List ); +extern Void addQualImport ( Text,Text ); +extern Void addUnqualImport ( Text,List ); + +extern Void tyconDefn ( Int,Cell,Cell,Cell ); +extern Void setTypeIns ( List ); +extern Void clearTypeIns ( Void ); +extern Type fullExpand ( Type ); +extern Bool isAmbiguous ( Type ); +extern Void ambigError ( Int,String,Cell,Type ); +extern Void classDefn ( Int,Cell,List,List ); +extern Void instDefn ( Int,Cell,Cell ); +extern Void addTupInst ( Class,Int ); +extern Name newDSel ( Class,Int ); #if TREX -extern Name implementRecShw Args((Text,Cell)); -extern Name implementRecEq Args((Text,Cell)); +extern Inst addRecShowInst ( Class,Ext ); +extern Inst addRecEqInst ( Class,Ext ); +#endif +extern List offsetTyvarsIn ( Type,List ); + + +extern List typeVarsIn ( Cell,List,List,List ); +extern List oclose ( List,List ); +extern List zonkTyvarsIn ( Type,List ); +extern Type zonkTyvar ( Int ); +extern Type zonkType ( Type,Int ); +extern Void primDefn ( Cell,List,Cell ); +extern Void defaultDefn ( Int,List ); +extern Void checkExp ( Void ); +extern Type conToTagType ( Tycon ); +extern Type tagToConType ( Tycon ); +extern Int visitClass ( Class ); + +#if EXPLAIN_INSTANCE_RESOLUTION +extern Void checkContext ( Void ); +#endif +extern Void checkDefns ( Module ); +extern Bool h98Pred ( Bool,Cell ); +extern Cell h98Context ( Bool,List ); +extern Void h98CheckCtxt ( Int,String,Bool,List,Inst ); +extern Void h98CheckType ( Int,String,Cell,Type ); +extern Void h98DoesntSupport ( Int,String ); + +extern Int userArity ( Name ); +extern List deriveEq ( Tycon ); +extern List deriveOrd ( Tycon ); +extern List deriveEnum ( Tycon ); +extern List deriveIx ( Tycon ); +extern List deriveShow ( Tycon ); +extern List deriveRead ( Cell ); +extern List deriveBounded ( Tycon ); +extern List checkPrimDefn ( Triple ); + +extern Void foreignImport ( Cell,Text,Pair,Cell,Cell ); +extern Void foreignExport ( Cell,Text,Cell,Cell,Cell ); + +extern Void implementForeignImport ( Name ); +extern Void implementForeignExport ( Name ); + +extern List foreignExports; /* foreign export declarations */ +extern List foreignImports; /* foreign import declarations */ + +extern Type primType ( Int /*AsmMonad*/ monad, + String a_kinds, String r_kinds ); + +extern Type typeCheckExp ( Bool ); +extern Void typeCheckDefns ( Void ); +extern Cell provePred ( Kinds,List,Cell ); +extern List simpleContext ( List,Int ); +extern Cell rhsExpr ( Cell ); +extern Int rhsLine ( Cell ); +extern Bool isProgType ( List,Type ); +extern Cell superEvid ( Cell,Class,Class ); +extern Void linkPreludeTC ( Void ); +extern Void linkPreludeCM ( Void ); +extern Void linkPrimNames ( Void ); + +extern Void compiler ( Int ); +extern Void compileDefns ( Void ); +extern Void compileExp ( Void ); +extern Bool failFree ( Cell ); +extern Int discrArity ( Cell ); + +extern Addr codeGen ( Name,Int,Cell ); +extern Void evalExp ( Void ); +extern Int shellEsc ( String ); +extern Int getTerminalWidth ( Void ); +extern Void normalTerminal ( Void ); +extern Void noechoTerminal ( Void ); +extern Int readTerminalChar ( Void ); +extern Void gcStarted ( Void ); +extern Void gcScanning ( Void ); +extern Void gcRecovered ( Int ); +extern Void gcCStack ( Void ); +extern Void needPrims ( Int ); +extern List calcFunDepsPreds ( List ); +extern Inst findInstFor ( Cell,Int ); +#if MULTI_INST +extern List findInstsFor ( Cell,Int ); #endif -extern Void addCfunTable Args((Tycon)); -extern Name succCfun Args((Name)); -extern Name nextCfun Args((Name,Name)); -extern Name cfunByNum Args((Name,Int)); -extern Void unwind Args((Cell)); -extern Void run Args((Addr,StackPtr)); - -extern Void eval Args((Cell)); -extern Cell evalWithNoError Args((Cell)); -extern Void evalFails Args((StackPtr)); - -extern Void abandon Args((String,Cell)); -extern Void outputString Args((FILE *)); -extern Void dialogue Args((Cell)); -#define consChar(c) ap(nameCons,mkChar(c)) -extern Int shellEsc Args((String)); -extern Int getTerminalWidth Args((Void)); -extern Void normalTerminal Args((Void)); -extern Void noechoTerminal Args((Void)); -extern Int readTerminalChar Args((Void)); -extern Void gcStarted Args((Void)); -extern Void gcScanning Args((Void)); -extern Void gcRecovered Args((Int)); -extern Void gcCStack Args((Void)); -extern Void needPrims Args((Int)); -extern List calcFunDepsPreds Args((List)); -extern Inst findInstFor Args((Cell,Int)); - -extern Type primType( Int /*AsmMonad*/ monad, String a_kinds, String r_kinds ); -#define aVar mkOffset(0) /* Simple skeleton for type var */ -/*-------------------------------------------------------------------------*/ +/*--------------------------------------------------------------------------- + * Debugging printers, and output-ery + *-------------------------------------------------------------------------*/ + +extern Void ppScripts ( Void ); +extern Void ppModules ( Void ); + +extern Void printStg ( FILE *fp, Cell /*StgVar*/ b); + +extern Void ppStg ( Cell /*StgVar*/ v ); +extern Void ppStgExpr ( Cell /*StgExpr*/ e ); +extern Void ppStgRhs ( Cell /*StgRhs*/ rhs ); +extern Void ppStgAlts ( List alts ); +extern Void ppStgPrimAlts ( List alts ); +extern Void ppStgVars ( List vs ); + +extern Void putChr ( Int ); +extern Void putStr ( String ); +extern Void putInt ( Int ); +extern Void putPtr ( Ptr ); + +extern Void unlexCharConst ( Cell ); +extern Void unlexStrConst ( Text ); +extern Void unlexVar ( Text ); +extern Void unlexVarStr ( String ); + +extern FILE *outputStream; /* current output stream */ +extern Int outColumn; /* current output column number */ + + + +/*--------------------------------------------------------------------------- + * Crude profiling (probably doesn't work) + *-------------------------------------------------------------------------*/ + +#ifdef CRUDE_PROFILING +extern void cp_init ( void ); +extern void cp_enter ( Cell /*StgVar*/ ); +extern void cp_bill_words ( int ); +extern void cp_bill_insns ( int ); +extern void cp_show ( void ); +#endif + + +/*--------------------------------------------------------------------------- + * For dynamic.c and general object-related stuff + *-------------------------------------------------------------------------*/ + +extern void* getDLLSymbol ( Int,String,String ); +extern Bool stdcallAllowed ( void ); + +#if LEADING_UNDERSCORE +#define MAYBE_LEADING_UNDERSCORE(sss) _##sss +#define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss +#else +#define MAYBE_LEADING_UNDERSCORE(sss) sss +#define MAYBE_LEADING_UNDERSCORE_STR(sss) sss +#endif + /*--------------------------------------------------------------------------- * Interrupting execution (signals, allowBreak): *-------------------------------------------------------------------------*/ -extern Bool breakOn Args((Bool)); +typedef + enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt } + HugsBreakAction; + +extern HugsBreakAction currentBreakAction; +extern HugsBreakAction setBreakAction ( HugsBreakAction ); -extern Bool broken; /* indicates interrupt received */ #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */ # define SIGBREAK 21 #endif -/* allowBreak: call to allow user to interrupt computation - * ctrlbrk: set control break handler - */ +/* ctrlbrk: set the interrupt handler. + Hugs relies on being able to do sigprocmask, since some of + the signal handlers do longjmps, and this zaps the previous + signal mask. So setHandler needs to do sigprocmask in order + to get the signal mask to a sane state each time. +*/ +#include +#define setHandler(bh) { sigset_t mask; \ + signal(SIGINT,bh); \ + sigemptyset(&mask); \ + sigaddset(&mask, SIGINT); \ + sigprocmask(SIG_UNBLOCK, &mask, NULL); \ + } -#if HUGS_FOR_WINDOWS -# define ctrlbrk(bh) -# define allowBreak() kbhit() -#else /* !HUGS_FOR_WINDOWS */ -# define ctrlbrk(bh) signal(SIGINT,bh); signal(SIGBREAK,bh) -# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); } -#endif /* !HUGS_FOR_WINDOWS */ /*--------------------------------------------------------------------------- * Environment variables and the registry *-------------------------------------------------------------------------*/ -/* On Win32 we can use the registry to supplement info in environment - * variables. - */ -/* AJG: Commented out for now for development */ -/* #define USE_REGISTRY (HAVE_WINDOWS_H && !__MSDOS__) */ - -#ifdef USE_REGISTRY -Bool writeRegString Args((String var, String val)); -String readRegString Args((String var, String def)); -Int readRegInt Args((String var, Int def)); -Bool writeRegInt Args((String var, Int val)); -#endif +#define N_INSTALLDIR 200 +extern char installDir[N_INSTALLDIR]; + /*--------------------------------------------------------------------------- * File operations: @@ -354,16 +602,16 @@ Bool writeRegInt Args((String var, Int val)); #if HAVE_UNISTD_H # include # include -#elif !HUGS_FOR_WINDOWS -extern int chdir Args((const char*)); #endif +extern int chdir ( const char* ); + #if HAVE_STDLIB_H # include #else -extern int system Args((const char *)); -extern double atof Args((const char *)); -extern void exit Args((int)); +extern int system ( const char * ); +extern double atof ( const char * ); +extern void exit ( int ); #endif #ifndef FILENAME_MAX /* should already be defined in an ANSI compiler*/ @@ -396,6 +644,9 @@ extern void exit Args((int)); # define filenamecmp(s1,s2) strcmp(s1,s2) #endif +#define HI_ENDING ".u_hi" + + /*--------------------------------------------------------------------------- * Pipe-related operations: * @@ -410,6 +661,7 @@ extern void exit Args((int)); #define pclose(x) _pclose(x) #endif + /*--------------------------------------------------------------------------- * Bit manipulation: *-------------------------------------------------------------------------*/ @@ -418,127 +670,339 @@ extern void exit Args((int)); #define placeInSet(n) ((-(n)-1)>>wordShift) #define maskInSet(n) (1<<((-(n)-1)&wordMask)) + /*--------------------------------------------------------------------------- * Function prototypes for code in machdep.c *-------------------------------------------------------------------------*/ -extern String findMPathname Args((String,String,String)); -extern String findPathname Args((String,String)); +extern String findMPathname ( String,String,String ); +extern String findPathname ( String,String ); +extern Int shellEsc ( String ); +extern Int getTerminalWidth ( Void ); +extern Void normalTerminal ( Void ); +extern Void noechoTerminal ( Void ); +extern Int readTerminalChar ( Void ); +extern Void gcStarted ( Void ); +extern Void gcScanning ( Void ); +extern Void gcRecovered ( Int ); +extern Void gcCStack ( Void ); -extern Int shellEsc Args((String)); -extern Int getTerminalWidth Args((Void)); -extern Void normalTerminal Args((Void)); -extern Void noechoTerminal Args((Void)); -extern Int readTerminalChar Args((Void)); -extern Void gcStarted Args((Void)); -extern Void gcScanning Args((Void)); -extern Void gcRecovered Args((Int)); -extern Void gcCStack Args((Void)); -/*-------------------------------------------------------------------------*/ +/*--------------------------------------------------------------------------- + * To do with reading interface and object files + *-------------------------------------------------------------------------*/ -extern Type typeInt64; -extern Type typeWord; -extern Type typeFloat; -extern Type typePrimArray; -extern Type typePrimByteArray; -extern Type typeRef; -extern Type typePrimMutableArray; -extern Type typePrimMutableByteArray; -extern Type typeStable; -extern Type typeWeak; -extern Type typeIO; -extern Type typeForeign; -extern Type typeMVar; -extern Type typeThreadId; -extern Type typeException; -extern Type typeIO; -extern Type typeST; +extern Cell parseInterface ( String,Long ); +extern List getInterfaceImports ( Cell ); +extern void processInterfaces ( List ); +extern Void getFileSize ( String, Long * ); +extern Void ifLinkConstrItbl ( Name n ); +extern Void hi_o_namesFromSrcName ( String,String*,String* oName ); +extern void* lookupObjName ( char* ); -extern Void foreignImport Args((Cell,Pair,Cell,Cell)); -extern List foreignImports; /* foreign import declarations */ -extern Void implementForeignImport Args((Name)); -extern Void foreignExport Args((Cell,Cell,Cell,Cell)); -extern List foreignExports; /* foreign export declarations */ -extern Void implementForeignExport Args((Name)); +extern String getExtraObjectInfo ( String primaryObjectName, + String extraFileName, + Int* extraFileSize ); -extern List diVars; -extern Int diNum; +extern List /* of ZTriple(I_INTERFACE, + Text--name of obj file, + Int--size of obj file) */ + ifaces_outstanding; -Int userArity Args((Name)); +/* -------------------------------------------------------------------------- + * Interpreter command structure + * ------------------------------------------------------------------------*/ -extern List deriveEq Args((Tycon)); -extern List deriveOrd Args((Tycon)); -extern List deriveEnum Args((Tycon)); -extern List deriveIx Args((Tycon)); -extern List deriveShow Args((Tycon)); -extern List deriveRead Args((Cell)); -extern List deriveBounded Args((Tycon)); -extern List checkPrimDefn Args((Triple)); +typedef Int Command; + +struct cmd { + String cmdString; + Command cmdCode; +}; + +extern Command readCommand ( struct cmd *, Char, Char ); + +#define EDIT 0 +#define FIND 1 +#define LOAD 2 +#define ALSO 3 +#define PROJECT 4 +#define RELOAD 5 +#define EVAL 6 +#define TYPEOF 7 +#define HELP 8 +#define NAMES 9 +#define BADCMD 10 +#define SET 11 +#define QUIT 12 +#define SYSTEM 13 +#define CHGDIR 14 +#define INFO 15 +#define COLLECT 16 +#define SETMODULE 17 +#define DUMP 18 +#define STATS 19 +#define BROWSE 20 +#define XPLAIN 21 +#define PNTVER 22 +#define NOCMD 23 -extern Bool typeMatches Args((Type,Type)); -extern Void evalExp Args((Void)); -extern Void linkControl Args((Int)); -extern Void deriveControl Args((Int)); -extern Void translateControl Args((Int)); -extern Void codegen Args((Int)); -extern Void machdep Args((Int)); -extern Void linkPreludeNames(void); +/* -------------------------------------------------------------------------- + * STG Syntax: + * + * Rhs -> STGCON (Con, [Atom]) + * | STGAPP (Var, [Atom]) -- delayed application + * | Expr + * + * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value + * | LAMBDA ([Var],Expr) -- all vars bound to NIL + * | CASE (Expr,[Alt]) -- algebraic case + * | PRIMCASE (Expr,[PrimAlt]) -- primitive case + * | STGPRIM (Prim,[Atom]) + * | STGAPP (Var, [Atom]) -- tail call + * | Var -- Abbreviation for STGAPP(Var,[]) + * + * Atom -> Var + * | CHAR -- unboxed + * | INT -- unboxed + * | BIGNUM -- unboxed + * | FLOAT -- unboxed + * | ADDR -- unboxed + * | STRING -- boxed + * + * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound + * | Name -- let-bound (effectively) + * -- always unboxed (PTR_REP) + * + * Alt -> DEEFALT (Var,Expr) -- var bound to NIL + * | CASEALT (Con,[Var],Expr) -- vars bound to NIL; + * -- Con is Name or TUPLE + * PrimAlt -> PRIMALT ([Var],Expr) -- vars bound to NIL or int + * + * We use pointer equality to distinguish variables. + * The info field of a Var is used as follows in various phases: + * + * Translation: unused (set to NIL on output) + * Freevar analysis: list of free vars after + * Lambda lifting: freevar list or UNIT on input, discarded after + * Code generation: unused + * Optimisation: number of uses (sort-of) of let-bound variable + * ------------------------------------------------------------------------*/ -extern Kind starToStar; /* Type -> Type */ -extern Type boundPair; /* (mkOffset(0),mkOffset(0)) */ -extern Type typeOrdering; +typedef Cell StgRhs; +typedef Cell StgExpr; +typedef Cell StgAtom; +typedef Cell StgVar; /* Could be a Name or an STGVAR */ +typedef Cell StgCaseAlt; +typedef Cell StgPrimAlt; +typedef Cell StgDiscr; +typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */ -extern Type conToTagType Args((Tycon)); -extern Type tagToConType Args((Tycon)); +#define mkStgLet(binds,body) ap(LETREC,pair(binds,body)) +#define stgLetBinds(e) fst(snd(e)) +#define stgLetBody(e) snd(snd(e)) -#define BOGUS(k) (-9000000-(k)) +#define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info)) +#define stgVarBody(e) fst3(snd(e)) +#define stgVarRep(e) snd3(snd(e)) +#define stgVarInfo(e) thd3(snd(e)) -extern Void putChr Args((Int)); -extern Void putStr Args((String)); -extern Void putInt Args((Int)); -extern Void putPtr Args((Ptr)); +#define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts)) +#define stgCaseScrut(e) fst(snd(e)) +#define stgCaseAlts(e) snd(snd(e)) -extern Void unlexCharConst Args((Cell)); -extern FILE *outputStream; /* current output stream */ -extern Int outColumn; /* current output column number */ +#define mkStgCaseAlt(con,vs,e) ap(CASEALT,triple(con,vs,e)) +#define stgCaseAltCon(alt) fst3(snd(alt)) +#define stgCaseAltVars(alt) snd3(snd(alt)) +#define stgCaseAltBody(alt) thd3(snd(alt)) -extern Void unlexStrConst Args((Text)); -extern Void unlexVar Args((Text)); -extern List offsetTyvarsIn Args((Type,List)); +#define mkStgDefault(v,e) ap(DEEFALT,pair(v,e)) +#define stgDefaultVar(alt) fst(snd(alt)) +#define stgDefaultBody(alt) snd(snd(alt)) +#define isDefaultAlt(alt) (fst(alt)==DEEFALT) -extern Void optimiseTopBinds Args((List)); -extern List cfunSfuns; /* List of (Cfun,[SelectorVar]) */ +#define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts)) +#define stgPrimCaseScrut(e) fst(snd(e)) +#define stgPrimCaseAlts(e) snd(snd(e)) -extern Void interface Args((Int)); +#define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body)) +#define stgPrimAltVars(alt) fst(snd(alt)) +#define stgPrimAltBody(alt) snd(snd(alt)) -extern Void getFileSize Args((String, Long *)); +#define mkStgApp(fun,args) ap(STGAPP,pair(fun,args)) +#define stgAppFun(e) fst(snd(e)) +#define stgAppArgs(e) snd(snd(e)) -extern Void loadInterface Args((String,Long)); +#define mkStgPrim(op,args) ap(STGPRIM,pair(op,args)) +#define stgPrimOp(e) fst(snd(e)) +#define stgPrimArgs(e) snd(snd(e)) -extern Void openGHCIface Args((Text)); -extern Void loadSharedLib Args((String)); -extern Void addGHCImports Args((Int,Text,List)); -extern Void addGHCExports Args((Cell,List)); -extern Void addGHCVar Args((Int,Text,Type)); -extern Void addGHCSynonym Args((Int,Cell,List,Type)); -extern Void addGHCDataDecl Args((Int,List,Cell,List,List)); -extern Void addGHCNewType Args((Int,List,Cell,List,Cell)); -extern Void addGHCClass Args((Int,List,Cell,List,List)); -extern Void addGHCInstance Args((Int,List,Pair,Text)); -extern Void finishInterfaces Args((Void)); +#define mkStgCon(con,args) ap(STGCON,pair(con,args)) +#define stgConCon(e) fst(snd(e)) +#define stgConArgs(e) snd(snd(e)) -extern Void hi_o_namesFromSrcName Args((String,String*,String* oName)); -extern Void parseInterface Args((String,Long)); +#define mkStgLambda(args,body) ap(LAMBDA,pair(args,body)) +#define stgLambdaArgs(e) fst(snd(e)) +#define stgLambdaBody(e) snd(snd(e)) -#define SMALL_INLINE_SIZE 9 +/* -------------------------------------------------------------------------- + * Utility functions for manipulating STG syntax trees. + * ------------------------------------------------------------------------*/ + +extern int stgConTag ( StgDiscr d ); +extern void* stgConInfo ( StgDiscr d ); +extern int stgDiscrTag ( StgDiscr d ); + +extern List makeArgs ( Int ); +extern StgExpr makeStgLambda ( List args, StgExpr body ); +extern StgExpr makeStgApp ( StgVar fun, List args ); +extern StgExpr makeStgLet ( List binds, StgExpr body ); +extern StgExpr makeStgIf ( StgExpr cond, StgExpr e1, StgExpr e2 ); +extern Bool isStgVar ( StgRhs rhs ); +extern Bool isAtomic ( StgRhs rhs ); +extern StgVar mkStgVar ( StgRhs rhs, Cell info ); + +#define mkStgRep(c) mkChar(c) + + +/* -------------------------------------------------------------------------- + * STG/backendish functions + * ------------------------------------------------------------------------*/ + +extern Void stgDefn ( Name n, Int arity, Cell e ); + +extern Void implementForeignImport ( Name ); +extern Void implementForeignExport ( Name ); +extern Void implementCfun ( Name, List ); +extern Void implementConToTag ( Tycon ); +extern Void implementTagToCon ( Tycon ); +extern Void implementPrim ( Name ); +extern Void implementTuple ( Int ); +#if TREX +extern Name implementRecShw ( Text ); +extern Name implementRecEq ( Text ); +#endif + +/* Association list storing globals assigned to dictionaries, tuples, etc */ +extern List stgGlobals; + +extern List liftBinds ( List binds ); +extern StgExpr substExpr ( List sub, StgExpr e ); +extern List freeVarsBind ( List, StgVar ); + +extern Void cgBinds ( StgRhs ); +extern void* closureOfVar ( StgVar ); +extern char* lookupHugsName ( void* ); -// nasty hack, but seems an easy to convey the object name -// and size to openGHCIface -char nameObj[FILENAME_MAX+1]; -int sizeObj; +/* -------------------------------------------------------------------------- + * Definitions for substitution data structure and operations. + * ------------------------------------------------------------------------*/ + +typedef struct { /* Each type variable contains: */ + Type bound; /* A type skeleton (unbound==NIL) */ + Int offs; /* Offset for skeleton */ + Kind kind; /* kind annotation */ +} Tyvar; + +extern Tyvar *tyvars; /* storage for type variables */ +extern Int typeOff; /* offset of result type */ +extern Type typeIs; /* skeleton of result type */ +extern Int typeFree; /* freedom in instantiated type */ +extern List predsAre; /* list of predicates in type */ +extern List genericVars; /* list of generic vars */ +extern List btyvars; /* explicitly scoped type vars */ + +#define tyvar(n) (tyvars+(n)) /* nth type variable */ +#define tyvNum(t) ((t)-tyvars) /* and the corresp. inverse funct. */ +#define isBound(t) (((t)->bound) && ((t)->bound!=SKOLEM)) +#define aVar mkOffset(0) /* Simple skeletons for type vars */ +#define bVar mkOffset(1) +#define enterBtyvs() btyvars = cons(NIL,btyvars) +#define leaveBtyvs() btyvars = tl(btyvars) + +#define deRef(tyv,t,o) while ((tyv=getTypeVar(t,o)) && isBound(tyv)) { \ + t = tyv->bound; \ + o = tyv->offs; \ + } + + /* offs values when isNull(bound): */ +#define FIXED_TYVAR 0 /* fixed in current assumption */ +#define UNUSED_GENERIC 1 /* not fixed, not yet encountered */ +#define GENERIC 2 /* GENERIC+n==nth generic var found*/ + +extern char *unifyFails; /* Unification error message */ + +extern Void emptySubstitution ( Void ); +extern Int newTyvars ( Int ); +#define newKindvars(n) newTyvars(n) +extern Int newKindedVars ( Kind ); +extern Kind simpleKind ( Int ); +extern Void instantiate ( Type ); + +extern Pair findBtyvs ( Text ); +extern Void markBtyvs ( Void ); +extern Type localizeBtyvs ( Type ); + +extern Tyvar *getTypeVar ( Type,Int ); +extern Void tyvarType ( Int ); +extern Void bindTv ( Int,Type,Int ); +extern Cell getDerefHead ( Type,Int ); +extern Void expandSyn ( Tycon, Int, Type *, Int * ); + +extern Void clearMarks ( Void ); +extern Void markAllVars ( Void ); +extern Void resetGenerics ( Void ); +extern Void markTyvar ( Int ); +extern Void markType ( Type,Int ); +extern Void markPred ( Cell ); + +extern Type copyTyvar ( Int ); +extern Type copyType ( Type,Int ); +extern Cell copyPred ( Cell,Int ); +extern Type dropRank2 ( Type,Int,Int ); +extern Type dropRank1 ( Type,Int,Int ); +extern Void liftRank2Args ( List,Int,Int ); +extern Type liftRank2 ( Type,Int,Int ); +extern Type liftRank1 ( Type,Int,Int ); +#ifdef DEBUG_TYPES +extern Type debugTyvar ( Int ); +extern Type debugType ( Type,Int ); +#endif +extern Kind copyKindvar ( Int ); +extern Kind copyKind ( Kind,Int ); + +extern Bool eqKind ( Kind,Kind ); +extern Kind getKind ( Cell,Int ); + +extern List genvarTyvar ( Int,List ); +extern List genvarType ( Type,Int,List ); + +extern Bool doesntOccurIn ( Tyvar*,Type,Int ); +extern Bool unify ( Type,Int,Type,Int ); +extern Bool kunify ( Kind,Int,Kind,Int ); + +extern Void typeTuple ( Cell ); +extern Void varKind ( Int ); + +extern Bool samePred ( Cell,Int,Cell,Int ); +extern Bool matchPred ( Cell,Int,Cell,Int ); +extern Bool unifyPred ( Cell,Int,Cell,Int ); +extern Inst findInstFor ( Cell,Int ); + +extern Void improve ( Int,List,List ); +extern Void improve1 ( Int,List,Cell,Int ); + +extern Bool sameSchemes ( Type,Type ); +extern Bool sameType ( Type,Int,Type,Int ); +extern Bool matchType ( Type,Int,Type,Int ); +extern Bool typeMatches ( Type,Type ); + +#ifdef DEBUG +extern Void checkBytecodeCount ( Void ); +#endif +/*-------------------------------------------------------------------------*/