Fix scoped type variables for expression type signatures
[ghc-hetmet.git] / rts / AutoApply.h
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The University of Glasgow 2002-2004
4  *
5  * Helper bits for the generic apply code (AutoApply.hc)
6  *
7  * -------------------------------------------------------------------------- */
8
9 #ifndef AUTOAPPLY_H
10 #define AUTOAPPLY_H
11
12 // Build a new PAP: function is in R1
13 // ret addr and m arguments taking up n words are on the stack.
14 // NB. x is a dummy argument attached to the 'for' label so that
15 // BUILD_PAP can be used multiple times in the same function.
16 #define BUILD_PAP(m,n,f,x)                              \
17     W_ pap;                                             \
18     W_ size;                                            \
19     W_ i;                                               \
20     size = SIZEOF_StgPAP + WDS(n);                      \
21     HP_CHK_NP_ASSIGN_SP0(size,f);                       \
22     TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));          \
23     TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);        \
24     pap = Hp + WDS(1) - size;                           \
25     SET_HDR(pap, stg_PAP_info, W_[CCCS]);               \
26     StgPAP_arity(pap) = HALF_W_(arity - m);             \
27     StgPAP_fun(pap)   = R1;                             \
28     StgPAP_n_args(pap) = HALF_W_(n);                    \
29     i = 0;                                              \
30   for##x:                                               \
31     if (i < n) {                                        \
32         StgPAP_payload(pap,i) = Sp(1+i);                \
33         i = i + 1;                                      \
34         goto for##x;                                    \
35     }                                                   \
36     R1 = pap;                                           \
37     Sp_adj(1 + n);                                      \
38     jump %ENTRY_CODE(Sp(0));
39
40 // Copy the old PAP, build a new one with the extra arg(s)
41 // ret addr and m arguments taking up n words are on the stack.
42 // NB. x is a dummy argument attached to the 'for' label so that
43 // BUILD_PAP can be used multiple times in the same function.
44 #define NEW_PAP(m,n,f,x)                                        \
45      W_ pap;                                                    \
46      W_ new_pap;                                                \
47      W_ size;                                                   \
48      W_ i;                                                      \
49      pap = R1;                                                  \
50      size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(pap))) + WDS(n);    \
51      HP_CHK_NP_ASSIGN_SP0(size,f);                              \
52      TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));                 \
53      TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);               \
54      new_pap = Hp + WDS(1) - size;                              \
55      SET_HDR(new_pap, stg_PAP_info, W_[CCCS]);                  \
56      StgPAP_arity(new_pap) = HALF_W_(arity - m);                \
57      W_ n_args;                                                 \
58      n_args = TO_W_(StgPAP_n_args(pap));                        \
59      StgPAP_n_args(new_pap) = HALF_W_(n_args + n);              \
60      StgPAP_fun(new_pap) = StgPAP_fun(pap);                     \
61      i = 0;                                                     \
62    for1##x:                                                     \
63      if (i < n_args) {                                          \
64          StgPAP_payload(new_pap,i) = StgPAP_payload(pap,i);     \
65          i = i + 1;                                             \
66          goto for1##x;                                          \
67      }                                                          \
68      i = 0;                                                     \
69    for2##x:                                                     \
70      if (i < n) {                                               \
71          StgPAP_payload(new_pap,n_args+i) = Sp(1+i);            \
72          i = i + 1;                                             \
73          goto for2##x;                                          \
74      }                                                          \
75      R1 = new_pap;                                              \
76      Sp_adj(n+1);                                               \
77      jump %ENTRY_CODE(Sp(0));
78
79 #endif /* APPLY_H */
80