ghc/interpreter/backend.h

   1
   2 /* --------------------------------------------------------------------------
   3  * STG syntax
   4  *
   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.
  10  *
  11  * $RCSfile: backend.h,v $
  12  * $Revision: 1.8 $
  13  * $Date: 2000/03/10 17:30:36 $
  14  * ------------------------------------------------------------------------*/
  15
  16 /* --------------------------------------------------------------------------
  17  * STG Syntax:
  18  *
  19  *   Rhs     -> STGCON   (Con, [Atom])
  20  *            | STGAPP   (Var, [Atom])     -- delayed application
  21  *            | Expr
  22  *
  23  *   Expr    -> LETREC   ([Var],Expr)      -- Vars contain their bound value
  24  *            | LAMBDA   ([Var],Expr)      -- all vars bound to NIL
  25  *            | CASE     (Expr,[Alt])      -- algebraic case
  26  *            | PRIMCASE (Expr,[PrimAlt])  -- primitive case
  27  *            | STGPRIM  (Prim,[Atom])
  28  *            | STGAPP   (Var, [Atom])     -- tail call
  29  *            | Var                        -- Abbreviation for STGAPP(Var,[])
  30  *
  31  *   Atom    -> Var
  32  *            | CHAR                       -- unboxed
  33  *            | INT                        -- unboxed
  34  *            | BIGNUM                     -- unboxed
  35  *            | FLOAT                      -- unboxed
  36  *            | ADDR                       -- unboxed
  37  *            | STRING                     -- boxed
  38  *
  39  *   Var     -> STGVAR   (Rhs,StgRep,info) -- let, case or lambda bound
  40  *            | Name                       -- let-bound (effectively)
  41  *                                         -- always unboxed (PTR_REP)
  42  *
  43  *   Alt     -> DEEFALT (Var,Expr)         -- var bound to NIL
  44  *            | CASEALT (Con,[Var],Expr)   -- vars bound to NIL;
  45  *                                         -- Con is Name or TUPLE
  46  *   PrimAlt -> PRIMALT ([Var],Expr)       -- vars bound to NIL or int
  47  *
  48  * We use pointer equality to distinguish variables.
  49  * The info field of a Var is used as follows in various phases:
  50  *
  51  * Translation:      unused (set to NIL on output)
  52  * Freevar analysis: list of free vars after
  53  * Lambda lifting:   freevar list or UNIT on input, discarded after
  54  * Code generation:  unused
  55  * Optimisation:     number of uses (sort-of) of let-bound variable
  56  * ------------------------------------------------------------------------*/
  57
  58 typedef Cell   StgRhs;
  59 typedef Cell   StgExpr;
  60 typedef Cell   StgAtom;
  61 typedef Cell   StgVar;       /* Could be a Name or an STGVAR */
  62 typedef Cell   StgCaseAlt;
  63 typedef Cell   StgPrimAlt;
  64 typedef Cell   StgDiscr;
  65 typedef Cell   StgRep;  /* PTR_REP | .. DOUBLE_REP */
  66
  67 #define mkStgLet(binds,body)       ap(LETREC,pair(binds,body))
  68 #define stgLetBinds(e)             fst(snd(e))
  69 #define stgLetBody(e)              snd(snd(e))
  70
  71 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
  72 #define stgVarBody(e)              fst3(snd(e))
  73 #define stgVarRep(e)               snd3(snd(e))
  74 #define stgVarInfo(e)              thd3(snd(e))
  75
  76 #define mkStgCase(scrut,alts)      ap(CASE,pair(scrut,alts))
  77 #define stgCaseScrut(e)            fst(snd(e))
  78 #define stgCaseAlts(e)             snd(snd(e))
  79
  80 #define mkStgCaseAlt(con,vs,e)     ap(CASEALT,triple(con,vs,e))
  81 #define stgCaseAltCon(alt)         fst3(snd(alt))
  82 #define stgCaseAltVars(alt)        snd3(snd(alt))
  83 #define stgCaseAltBody(alt)        thd3(snd(alt))
  84
  85 #define mkStgDefault(v,e)          ap(DEEFALT,pair(v,e))
  86 #define stgDefaultVar(alt)         fst(snd(alt))
  87 #define stgDefaultBody(alt)        snd(snd(alt))
  88 #define isDefaultAlt(alt)          (fst(alt)==DEEFALT)
  89
  90 #define mkStgPrimCase(scrut,alts)  ap(PRIMCASE,pair(scrut,alts))
  91 #define stgPrimCaseScrut(e)        fst(snd(e))
  92 #define stgPrimCaseAlts(e)         snd(snd(e))
  93
  94 #define mkStgPrimAlt(vs,body)      ap(PRIMALT,pair(vs,body))
  95 #define stgPrimAltVars(alt)        fst(snd(alt))
  96 #define stgPrimAltBody(alt)        snd(snd(alt))
  97
  98 #define mkStgApp(fun,args)         ap(STGAPP,pair(fun,args))
  99 #define stgAppFun(e)               fst(snd(e))
 100 #define stgAppArgs(e)              snd(snd(e))
 101
 102 #define mkStgPrim(op,args)         ap(STGPRIM,pair(op,args))
 103 #define stgPrimOp(e)               fst(snd(e))
 104 #define stgPrimArgs(e)             snd(snd(e))
 105
 106 #define mkStgCon(con,args)         ap(STGCON,pair(con,args))
 107 #define stgConCon(e)               fst(snd(e))
 108 #define stgConArgs(e)              snd(snd(e))
 109
 110 #define mkStgLambda(args,body)     ap(LAMBDA,pair(args,body))
 111 #define stgLambdaArgs(e)           fst(snd(e))
 112 #define stgLambdaBody(e)           snd(snd(e))
 113
 114 extern int stgConTag  ( StgDiscr d );
 115 extern void* stgConInfo ( StgDiscr d );
 116 extern int stgDiscrTag( StgDiscr d );
 117
 118 /* --------------------------------------------------------------------------
 119  * Utility functions for manipulating STG syntax trees.
 120  * ------------------------------------------------------------------------*/
 121
 122 extern List    makeArgs      ( Int );
 123 extern StgExpr makeStgLambda ( List args,  StgExpr body );
 124 extern StgExpr makeStgApp    ( StgVar fun, List args );
 125 extern StgExpr makeStgLet    ( List binds, StgExpr body );
 126 extern StgExpr makeStgIf     ( StgExpr cond, StgExpr e1, StgExpr e2 );
 127 extern Bool    isStgVar      ( StgRhs rhs );
 128 extern Bool    isAtomic      ( StgRhs rhs );
 129 extern StgVar  mkStgVar      ( StgRhs rhs, Cell info );
 130
 131 #define mkStgRep(c) mkChar(c)
 132
 133 /*-------------------------------------------------------------------------*/
 134
 135
 136
 137
 138 extern Void  cgBinds       Args((StgRhs));
 139 extern void* closureOfVar  Args((StgVar));
 140 extern char* lookupHugsName Args((void*));
 141
 142
 143
 144 extern Void stgDefn       Args(( Name n, Int arity, Cell e ));
 145
 146 extern  Void   implementForeignImport Args((Name));
 147 extern  Void   implementForeignExport Args((Name));
 148 extern  Void   implementCfun          Args((Name, List));
 149 extern  Void   implementConToTag Args((Tycon));
 150 extern  Void   implementTagToCon Args((Tycon));
 151 extern  Void   implementPrim     Args((Name));
 152 extern  Void   implementTuple    Args((Int));
 153 #if TREX
 154 extern  Name   implementRecShw   Args((Text,Cell));
 155 extern  Name   implementRecEq    Args((Text,Cell));
 156 #endif
 157
 158 /* Association list storing globals assigned to dictionaries, tuples, etc */
 159 extern List stgGlobals;
 160
 161 extern Void optimiseBind Args((StgVar));
 162
 163
 164
 165
 166 Void printStg( FILE *fp, StgVar b);
 167
 168 extern Void ppStg        ( StgVar v );
 169 extern Void ppStgExpr    ( StgExpr e );
 170 extern Void ppStgRhs     ( StgRhs rhs );
 171 extern Void ppStgAlts    ( List alts );
 172 extern Void ppStgPrimAlts( List alts );
 173 extern Void ppStgVars    ( List vs );
 174
 175
 176 extern List liftBinds( List binds );
 177 extern Void liftControl ( Int what );
 178
 179 extern StgExpr substExpr ( List sub, StgExpr e );
 180
 181 extern List freeVarsBind Args((List, StgVar));
 182
 183 #ifdef CRUDE_PROFILING
 184 extern void cp_init ( void );
 185 extern void cp_enter ( Cell /*StgVar*/ );
 186 extern void cp_bill_words ( int );
 187 extern void cp_bill_insns ( int );
 188 extern void cp_show ( void );
 189 #endif