1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
/* --------------------------------------------------------------------------
* STG syntax
*
* Copyright (c) The University of Nottingham and Yale University, 1994-1997.
* All rights reserved. See NOTICE for details and conditions of use etc...
* Hugs version 1.4, December 1997
*
* $RCSfile: backend.h,v $
* $Revision: 1.4 $
* $Date: 1999/04/27 10:06:47 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
* 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
* ------------------------------------------------------------------------*/
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 */
#define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
#define stgLetBinds(e) fst(snd(e))
#define stgLetBody(e) snd(snd(e))
#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))
#define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
#define stgCaseScrut(e) fst(snd(e))
#define stgCaseAlts(e) snd(snd(e))
#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))
#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)
#define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
#define stgPrimCaseScrut(e) fst(snd(e))
#define stgPrimCaseAlts(e) snd(snd(e))
#define mkStgPrimAlt(vs,body) ap(PRIMALT,pair(vs,body))
#define stgPrimAltVars(alt) fst(snd(alt))
#define stgPrimAltBody(alt) snd(snd(alt))
#define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
#define stgAppFun(e) fst(snd(e))
#define stgAppArgs(e) snd(snd(e))
#define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
#define stgPrimOp(e) fst(snd(e))
#define stgPrimArgs(e) snd(snd(e))
#define mkStgCon(con,args) ap(STGCON,pair(con,args))
#define stgConCon(e) fst(snd(e))
#define stgConArgs(e) snd(snd(e))
#define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
#define stgLambdaArgs(e) fst(snd(e))
#define stgLambdaBody(e) snd(snd(e))
extern int stgConTag ( StgDiscr d );
extern void* stgConInfo ( StgDiscr d );
extern int stgDiscrTag( StgDiscr d );
/* --------------------------------------------------------------------------
* Utility functions for manipulating STG syntax trees.
* ------------------------------------------------------------------------*/
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 );
extern Int stgSize ( StgExpr e );
#define mkStgRep(c) mkChar(c)
/*-------------------------------------------------------------------------*/
extern Void cgBinds Args((StgRhs));
extern void* closureOfVar Args((StgVar));
extern char* lookupHugsName Args((void*));
extern Void stgDefn Args(( Name n, Int arity, Cell e ));
extern Void implementForeignImport Args((Name));
extern Void implementForeignExport Args((Name));
extern Void implementCfun Args((Name, List));
extern Void implementConToTag Args((Tycon));
extern Void implementTagToCon Args((Tycon));
extern Void implementPrim Args((Name));
extern Void implementTuple Args((Int));
#if TREX
extern Name implementRecShw Args((Text));
extern Name implementRecEq Args((Text));
#endif
/* Association list storing globals assigned to dictionaries, tuples, etc */
extern List stgGlobals;
extern Void optimiseBind Args((StgVar));
Void printStg( FILE *fp, StgVar b);
#if DEBUG_PRINTER
extern Void ppStg ( StgVar v );
extern Void ppStgExpr ( StgExpr e );
extern Void ppStgRhs ( StgRhs rhs );
extern Void ppStgAlts ( List alts );
extern Void ppStgPrimAlts( List alts );
extern Void ppStgVars ( List vs );
#endif
extern List liftBinds( List binds );
extern Void liftControl ( Int what );
extern StgExpr substExpr ( List sub, StgExpr e );
extern StgExpr zubstExpr ( List sub, StgExpr e );
extern List freeVarsBind Args((List, StgVar));
extern Void optimiseBind Args((StgVar));
#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
|
