2 /* --------------------------------------------------------------------------
5 * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
6 * All rights reserved. See NOTICE for details and conditions of use etc...
7 * Hugs version 1.4, December 1997
9 * $RCSfile: backend.h,v $
11 * $Date: 1999/03/01 14:46:42 $
12 * ------------------------------------------------------------------------*/
14 /* --------------------------------------------------------------------------
17 * Rhs -> STGCON (Con, [Atom])
18 * | STGAPP (Var, [Atom]) -- delayed application
21 * Expr -> LETREC ([Var],Expr) -- Vars contain their bound value
22 * | LAMBDA ([Var],Expr) -- all vars bound to NIL
23 * | CASE (Expr,[Alt]) -- algebraic case
24 * | PRIMCASE (Expr,[PrimAlt]) -- primitive case
25 * | STGPRIM (Prim,[Atom])
26 * | STGAPP (Var, [Atom]) -- tail call
27 * | Var -- Abbreviation for STGAPP(Var,[])
37 * Var -> STGVAR (Rhs,StgRep,info) -- let, case or lambda bound
38 * | Name -- let-bound (effectively)
39 * -- always unboxed (PTR_REP)
42 * Pat -> Var -- bound to a constructor, a tuple or unbound
43 * PrimAlt -> ([PrimPat],Expr)
44 * PrimPat -> Var -- bound to int or unbound
46 * We use pointer equality to distinguish variables.
47 * The info field of a Var is used as follows in various phases:
49 * Translation: unused (set to NIL on output)
50 * Freevar analysis: list of free vars after
51 * Lambda lifting: freevar list or UNIT on input, discarded after
52 * Code generation: unused
53 * ------------------------------------------------------------------------*/
58 typedef Cell StgVar; /* Could be a Name or an STGVAR */
59 typedef Pair StgCaseAlt;
60 typedef StgVar StgPat;
61 typedef Cell StgDiscr;
62 typedef Pair StgPrimAlt;
63 typedef StgVar StgPrimPat;
64 typedef Cell StgRep; /* PTR_REP | .. DOUBLE_REP */
66 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
67 #define stgLetBinds(e) fst(snd(e))
68 #define stgLetBody(e) snd(snd(e))
70 #define mkStgPrimVar(rhs,rep,info) ap(STGVAR,triple(rhs,rep,info))
71 #define stgVarBody(e) fst3(snd(e))
72 #define stgVarRep(e) snd3(snd(e))
73 #define stgVarInfo(e) thd3(snd(e))
75 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
76 #define stgCaseScrut(e) fst(snd(e))
77 #define stgCaseAlts(e) snd(snd(e))
79 #define mkStgCaseAlt(discr,vs,e) pair(mkStgVar(mkStgCon(discr,vs),NIL),e)
80 #define stgCaseAltPat(alt) fst(alt)
81 #define stgCaseAltBody(alt) snd(alt)
83 #define stgPatDiscr(pat) stgConCon(stgVarBody(pat))
84 #define stgPatVars(pat) stgConArgs(stgVarBody(pat))
86 #define isDefaultPat(pat) (isNull(stgVarBody(pat)))
87 #define isStgDefault(alt) (isDefaultPat(stgCaseAltPat(alt)))
88 #define mkStgDefault(v,e) pair(v,e)
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) pair(vs,body)
95 #define stgPrimAltPats(alt) fst(alt)
96 #define stgPrimAltBody(alt) 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 );
130 extern StgVar mkStgVar ( StgRhs rhs, Cell info );
132 #define mkSeq(x,y) mkStgCase(mkStgApp(nameForce,singleton(x)),singleton(mkStgDefault(mkStgVar(NIL,NIL),y)))
135 #define mkStgRep(c) mkChar(c)
137 /*-------------------------------------------------------------------------*/
142 extern Void cgBinds Args((StgRhs));
143 extern void* closureOfVar Args((StgVar));
144 extern char* lookupHugsName Args((void*));
148 extern Void stgDefn Args(( Name n, Int arity, Cell e ));
150 extern Void implementForeignImport Args((Name));
151 extern Void implementForeignExport Args((Name));
152 extern Void implementCfun Args((Name, List));
153 extern Void implementConToTag Args((Tycon));
154 extern Void implementTagToCon Args((Tycon));
155 extern Void implementPrim Args((Name));
156 extern Void implementTuple Args((Int));
158 extern Name implementRecShw Args((Text));
159 extern Name implementRecEq Args((Text));
162 /* Association list storing globals assigned to dictionaries, tuples, etc */
163 extern List stgGlobals;
165 extern Void optimiseBind Args((StgVar));
170 Void printStg( FILE *fp, StgVar b);
173 extern Void ppStg ( StgVar v );
174 extern Void ppStgExpr ( StgExpr e );
175 extern Void ppStgRhs ( StgRhs rhs );
176 extern Void ppStgAlts ( List alts );
177 extern Void ppStgPrimAlts( List alts );
178 extern Void ppStgVars ( List vs );
182 extern List liftBinds( List binds );
183 extern Void liftControl ( Int what );
185 extern StgExpr substExpr ( List sub, StgExpr e );
186 extern List freeVarsBind Args((List, StgVar));
187 extern Void optimiseBind Args((StgVar));