From a73f9466351b57ffb8318d8741afe53016349f76 Mon Sep 17 00:00:00 2001 From: sewardj Date: Wed, 3 Feb 1999 17:05:14 +0000 Subject: [PATCH] [project @ 1999-02-03 17:05:14 by sewardj] Renamed stg.h to backend.h. --- ghc/interpreter/backend.h | 188 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 188 insertions(+) create mode 100644 ghc/interpreter/backend.h diff --git a/ghc/interpreter/backend.h b/ghc/interpreter/backend.h new file mode 100644 index 0000000..1b4a6e2 --- /dev/null +++ b/ghc/interpreter/backend.h @@ -0,0 +1,188 @@ + +/* -------------------------------------------------------------------------- + * 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.1 $ + * $Date: 1999/02/03 17:05:14 $ + * ------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * 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]) + * | PRIMCASE (Expr,[PrimAlt]) + * | 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 -> (Pat,Expr) + * Pat -> Var -- bound to a constructor, a tuple or unbound + * PrimAlt -> ([PrimPat],Expr) + * PrimPat -> Var -- bound to int or unbound + * + * 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 + * ------------------------------------------------------------------------*/ + +typedef Cell StgRhs; +typedef Cell StgExpr; +typedef Cell StgAtom; +typedef Cell StgVar; /* Could be a Name or an STGVAR */ +typedef Pair StgCaseAlt; +typedef StgVar StgPat; +typedef Cell StgDiscr; +typedef Pair StgPrimAlt; +typedef StgVar StgPrimPat; +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(discr,vs,e) pair(mkStgVar(mkStgCon(discr,vs),NIL),e) +#define stgCaseAltPat(alt) fst(alt) +#define stgCaseAltBody(alt) snd(alt) + +#define stgPatDiscr(pat) stgConCon(stgVarBody(pat)) +#define stgPatVars(pat) stgConArgs(stgVarBody(pat)) + +#define isDefaultPat(pat) (isNull(stgVarBody(pat))) +#define isStgDefault(alt) (isDefaultPat(stgCaseAltPat(alt))) +#define mkStgDefault(v,e) pair(v,e) + +#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) pair(vs,body) +#define stgPrimAltPats(alt) fst(alt) +#define stgPrimAltBody(alt) 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 ); + +#define mkSeq(x,y) mkStgCase(mkStgApp(nameForce,singleton(x)),singleton(mkStgDefault(mkStgVar(NIL,NIL),y))) + + +#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 List freeVarsBind Args((List, StgVar)); +extern Void optimiseBind Args((StgVar)); + -- 1.7.10.4