[project @ 1999-02-03 17:05:14 by sewardj]

Renamed stg.h to backend.h.

diff --git a/ghc/interpreter/backend.h b/ghc/interpreter/backend.h
new file mode 100644 (file)
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));
+