ghc/interpreter/stg.h

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * STG syntax
   4  *
   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
   8  *
   9  * $RCSfile: stg.h,v $
  10  * $Revision: 1.2 $
  11  * $Date: 1998/12/02 13:22:39 $
  12  * ------------------------------------------------------------------------*/
  13
  14 /* --------------------------------------------------------------------------
  15  * STG Syntax:
  16  *
  17  *   Rhs     -> STGCON   (Con, [Atom])
  18  *            | STGAPP   (Var, [Atom])     -- delayed application
  19  *            | Expr
  20  *
  21  *   Expr    -> LETREC   ([Var],Expr)      -- Vars contain their bound value
  22  *            | LAMBDA   ([Var],Expr)      -- all vars bound to NIL
  23  *            | CASE     (Expr,[Alt])
  24  *            | PRIMCASE (Expr,[PrimAlt])
  25  *            | STGPRIM  (Prim,[Atom])
  26  *            | STGAPP   (Var, [Atom])     -- tail call
  27  *            | Var                        -- Abbreviation for STGAPP(Var,[])
  28  *
  29  *   Atom    -> Var
  30  *            | CHAR                       -- unboxed
  31  *            | INT                        -- unboxed
  32  *            | BIGNUM                     -- unboxed
  33  *            | FLOAT                      -- unboxed
  34  *            | ADDR                       -- unboxed
  35  *            | STRING                     -- boxed
  36  *
  37  *   Var     -> STGVAR   (Rhs,StgRep,info) -- let, case or lambda bound
  38  *            | Name                       -- let-bound (effectively)
  39  *                                         -- always unboxed (PTR_REP)
  40  *
  41  *   Alt     -> (Pat,Expr)
  42  *   Pat     -> Var               -- bound to a constructor, a tuple or unbound
  43  *   PrimAlt -> ([PrimPat],Expr)
  44  *   PrimPat -> Var               -- bound to int or unbound
  45  *
  46  * We use pointer equality to distinguish variables.
  47  * The info field of a Var is used as follows in various phases:
  48  *
  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  * ------------------------------------------------------------------------*/
  54
  55 typedef Cell   StgRhs;
  56 typedef Cell   StgExpr;
  57 typedef Cell   StgAtom;
  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 */
  65
  66 #define mkStgLet(binds,body) ap(LETREC,pair(binds,body))
  67 #define stgLetBinds(e)       fst(snd(e))
  68 #define stgLetBody(e)        snd(snd(e))
  69
  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))
  74
  75 #define mkStgCase(scrut,alts) ap(CASE,pair(scrut,alts))
  76 #define stgCaseScrut(e)       fst(snd(e))
  77 #define stgCaseAlts(e)        snd(snd(e))
  78
  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)
  82
  83 #define stgPatDiscr(pat)         stgConCon(stgVarBody(pat))
  84 #define stgPatVars(pat)          stgConArgs(stgVarBody(pat))
  85
  86 #define isDefaultPat(pat)        (isNull(stgVarBody(pat)))
  87 #define isStgDefault(alt)        (isDefaultPat(stgCaseAltPat(alt)))
  88 #define mkStgDefault(v,e)        pair(v,e)
  89
  90 #define mkStgPrimCase(scrut,alts) ap(PRIMCASE,pair(scrut,alts))
  91 #define stgPrimCaseScrut(e) fst(snd(e))
  92 #define stgPrimCaseAlts(e)  snd(snd(e))
  93
  94 #define mkStgPrimAlt(vs,body)    pair(vs,body)
  95 #define stgPrimAltPats(alt)      fst(alt)
  96 #define stgPrimAltBody(alt)      snd(alt)
  97
  98 #define mkStgApp(fun,args) ap(STGAPP,pair(fun,args))
  99 #define stgAppFun(e)       fst(snd(e))
 100 #define stgAppArgs(e)      snd(snd(e))
 101
 102 #define mkStgPrim(op,args) ap(STGPRIM,pair(op,args))
 103 #define stgPrimOp(e)       fst(snd(e))
 104 #define stgPrimArgs(e)     snd(snd(e))
 105
 106 #define mkStgCon(con,args) ap(STGCON,pair(con,args))
 107 #define stgConCon(e)       fst(snd(e))
 108 #define stgConArgs(e)      snd(snd(e))
 109
 110 #define mkStgLambda(args,body) ap(LAMBDA,pair(args,body))
 111 #define stgLambdaArgs(e)       fst(snd(e))
 112 #define stgLambdaBody(e)       snd(snd(e))
 113
 114 extern int stgConTag  ( StgDiscr d );
 115 extern void* stgConInfo ( StgDiscr d );
 116 extern int stgDiscrTag( StgDiscr d );
 117
 118 /* --------------------------------------------------------------------------
 119  * Utility functions for manipulating STG syntax trees.
 120  * ------------------------------------------------------------------------*/
 121
 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
 130 extern StgVar  mkStgVar      ( StgRhs rhs, Cell info );
 131
 132 #define mkSeq(x,y) mkStgCase(mkStgApp(nameForce,singleton(x)),singleton(mkStgDefault(mkStgVar(NIL,NIL),y)))
 133
 134
 135 #define mkStgRep(c) mkChar(c)
 136
 137 /*-------------------------------------------------------------------------*/
 138
 139
 140
 141