2 /* --------------------------------------------------------------------------
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: backend.h,v $
13 * $Date: 2000/03/10 14:53:00 $
14 * ------------------------------------------------------------------------*/
16 /* --------------------------------------------------------------------------
19 * Rhs -> STGCON (Con, [Atom])
20 * | STGAPP (Var, [Atom]) -- delayed application
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,[])
39 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
40 * | Name -- let-bound (effectively)
41 * -- always unboxed (PTR_REP)
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
48 * We use pointer equality to distinguish variables.
49 * The info field of a Var is used as follows in various phases:
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 * ------------------------------------------------------------------------*/
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 */
67 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
68 #define stgLetBinds(e) fst(snd(e))
69 #define stgLetBody(e) snd(snd(e))
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))
76 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
77 #define stgCaseScrut(e) fst(snd(e))
78 #define stgCaseAlts(e) snd(snd(e))
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))
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)
90 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
91 #define stgPrimCaseScrut(e) fst(snd(e))
92 #define stgPrimCaseAlts(e) snd(snd(e))
94 #define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
95 #define stgPrimAltVars(alt) fst(snd(alt))
96 #define stgPrimAltBody(alt) snd(snd(alt))
98 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
99 #define stgAppFun(e) fst(snd(e))
100 #define stgAppArgs(e) snd(snd(e))
102 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
103 #define stgPrimOp(e) fst(snd(e))
104 #define stgPrimArgs(e) snd(snd(e))
106 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
107 #define stgConCon(e) fst(snd(e))
108 #define stgConArgs(e) snd(snd(e))
110 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
111 #define stgLambdaArgs(e) fst(snd(e))
112 #define stgLambdaBody(e) snd(snd(e))
114 extern int stgConTag ( StgDiscr d );
115 extern void* stgConInfo ( StgDiscr d );
116 extern int stgDiscrTag( StgDiscr d );
118 /* --------------------------------------------------------------------------
119 * Utility functions for manipulating STG syntax trees.
120 * ------------------------------------------------------------------------*/
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 );
131 #define mkStgRep(c) mkChar(c)
133 /*-------------------------------------------------------------------------*/
138 extern Void cgBinds Args((StgRhs));
139 extern void* closureOfVar Args((StgVar));
140 extern char* lookupHugsName Args((void*));
144 extern Void stgDefn Args(( Name n, Int arity, Cell e ));
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));
154 extern Name implementRecShw Args((Text));
155 extern Name implementRecEq Args((Text));
158 /* Association list storing globals assigned to dictionaries, tuples, etc */
159 extern List stgGlobals;
161 extern Void optimiseBind Args((StgVar));
166 Void printStg( FILE *fp, StgVar b);
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 );
176 extern List liftBinds( List binds );
177 extern Void liftControl ( Int what );
179 extern StgExpr substExpr ( List sub, StgExpr e );
181 extern List freeVarsBind Args((List, StgVar));
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 );