ghc/interpreter/stgSubst.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Substitute variables in an expression
   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: stgSubst.c,v $
  10  * $Revision: 1.3 $
  11  * $Date: 1999/02/03 17:08:40 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #include "prelude.h"
  15 #include "storage.h"
  16 #include "backend.h"
  17 #include "connect.h"
  18 #include "errors.h"
  19
  20 /* --------------------------------------------------------------------------
  21  * Local function prototypes:
  22  * ------------------------------------------------------------------------*/
  23
  24 static StgVar     substVar     ( List sub, StgVar v );
  25 static StgAtom    substAtom    ( List sub, StgAtom a );
  26 static void       substBind    ( List sub, StgVar bind );
  27 static void       substAlt     ( List sub, StgCaseAlt alt );
  28 static void       substPrimAlt ( List sub, StgPrimAlt alt );
  29
  30 /* --------------------------------------------------------------------------
  31  * Substitute variables throughout an expression - updating in place.
  32  * ------------------------------------------------------------------------*/
  33
  34 static StgVar substVar( List sub, StgVar v )
  35 {
  36     Pair p = cellAssoc(v,sub);
  37     if (nonNull(p)) {
  38         return snd(p);
  39     } else {
  40         return v;
  41     }
  42 }
  43
  44 static StgAtom substAtom ( List sub, StgAtom a )
  45 {
  46     switch (whatIs(a)) {
  47     case STGVAR:
  48             return substVar(sub,a);
  49     default:
  50             return a;
  51     }
  52 }
  53
  54 static Void substBind( List sub, StgVar bind )
  55 {
  56     StgRhs rhs = stgVarBody(bind);
  57     switch (whatIs(rhs)) {
  58     case STGCON:
  59             map1Over(substAtom,sub,stgConArgs(rhs));
  60             return;
  61     default:
  62             stgVarBody(bind) = substExpr(sub,rhs);
  63             return;
  64     }
  65 }
  66
  67 static Void substAlt( List sub, StgCaseAlt alt )
  68 {
  69     stgCaseAltBody(alt) = substExpr(sub,stgCaseAltBody(alt));
  70 }
  71
  72 static Void substPrimAlt( List sub, StgPrimAlt alt )
  73 {
  74     stgPrimAltBody(alt) = substExpr(sub,stgPrimAltBody(alt));
  75 }
  76
  77 StgExpr substExpr( List sub, StgExpr e )
  78 {
  79     switch (whatIs(e)) {
  80     case LETREC:
  81             map1Proc(substBind,sub,stgLetBinds(e));
  82             stgLetBody(e) = substExpr(sub,stgLetBody(e));
  83             break;
  84     case LAMBDA:
  85             stgLambdaBody(e) = substExpr(sub,stgLambdaBody(e));
  86             break;
  87     case CASE:
  88             stgCaseScrut(e) = substExpr(sub,stgCaseScrut(e));
  89             map1Proc(substAlt,sub,stgCaseAlts(e));
  90             break;
  91     case PRIMCASE:
  92             stgPrimCaseScrut(e) = substExpr(sub,stgPrimCaseScrut(e));
  93             map1Proc(substPrimAlt,sub,stgPrimCaseAlts(e));
  94             break;
  95     case STGPRIM:
  96             map1Over(substAtom,sub,stgPrimArgs(e));
  97             break;
  98     case STGAPP:
  99             stgAppFun(e) = substVar(sub,stgAppFun(e));
 100             map1Over(substAtom,sub,stgAppArgs(e));
 101             break;
 102     case STGVAR:
 103     case NAME:
 104             return substVar(sub,e);
 105     default:
 106             internal("substExpr");
 107     }
 108     return e;
 109 }
 110
 111 /*-------------------------------------------------------------------------*/