ghc/compiler/yaccParser/U_binding.hs

   1
   2
   3 module U_binding where
   4 import UgenUtil
   5 import Util
   6
   7 import U_coresyn        ( U_coresyn ) -- for interfaces only
   8 import U_hpragma
   9 import U_list
  10 import U_literal        ( U_literal ) -- for interfaces only
  11 import U_ttype
  12 data U_binding = U_tbind U_list U_ttype U_list U_list U_long U_hpragma | U_nbind U_ttype U_ttype U_long U_hpragma | U_pbind U_list U_long | U_fbind U_list U_long | U_abind U_binding U_binding | U_lbind U_binding U_binding | U_ebind U_list U_binding U_long | U_hbind U_list U_binding U_long | U_ibind U_list U_unkId U_ttype U_binding U_long U_hpragma | U_dbind U_list U_long | U_cbind U_list U_ttype U_binding U_long U_hpragma | U_sbind U_list U_ttype U_long U_hpragma | U_mbind U_stringId U_list U_list U_long | U_nullbind | U_import U_stringId U_list U_list U_binding U_stringId U_long | U_hiding U_stringId U_list U_list U_binding U_stringId U_long | U_vspec_uprag U_unkId U_list U_long | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag U_unkId U_ttype U_long | U_inline_uprag U_unkId U_list U_long | U_deforest_uprag U_unkId U_long | U_magicuf_uprag U_unkId U_stringId U_long | U_abstract_uprag U_unkId U_long | U_dspec_uprag U_unkId U_list U_long
  13
  14 rdU_binding :: _Addr -> UgnM U_binding
  15 rdU_binding t
  16   = ioToUgnM (_ccall_ tbinding t) `thenUgn` \ tag@(I# _) ->
  17     if tag == ``tbind'' then
  18         ioToUgnM (_ccall_ gtbindc t) `thenUgn` \ x_gtbindc ->
  19         rdU_list x_gtbindc `thenUgn` \ y_gtbindc ->
  20         ioToUgnM (_ccall_ gtbindid t) `thenUgn` \ x_gtbindid ->
  21         rdU_ttype x_gtbindid `thenUgn` \ y_gtbindid ->
  22         ioToUgnM (_ccall_ gtbindl t) `thenUgn` \ x_gtbindl ->
  23         rdU_list x_gtbindl `thenUgn` \ y_gtbindl ->
  24         ioToUgnM (_ccall_ gtbindd t) `thenUgn` \ x_gtbindd ->
  25         rdU_list x_gtbindd `thenUgn` \ y_gtbindd ->
  26         ioToUgnM (_ccall_ gtline t) `thenUgn` \ x_gtline ->
  27         rdU_long x_gtline `thenUgn` \ y_gtline ->
  28         ioToUgnM (_ccall_ gtpragma t) `thenUgn` \ x_gtpragma ->
  29         rdU_hpragma x_gtpragma `thenUgn` \ y_gtpragma ->
  30         returnUgn (U_tbind y_gtbindc y_gtbindid y_gtbindl y_gtbindd y_gtline y_gtpragma)
  31     else if tag == ``nbind'' then
  32         ioToUgnM (_ccall_ gnbindid t) `thenUgn` \ x_gnbindid ->
  33         rdU_ttype x_gnbindid `thenUgn` \ y_gnbindid ->
  34         ioToUgnM (_ccall_ gnbindas t) `thenUgn` \ x_gnbindas ->
  35         rdU_ttype x_gnbindas `thenUgn` \ y_gnbindas ->
  36         ioToUgnM (_ccall_ gnline t) `thenUgn` \ x_gnline ->
  37         rdU_long x_gnline `thenUgn` \ y_gnline ->
  38         ioToUgnM (_ccall_ gnpragma t) `thenUgn` \ x_gnpragma ->
  39         rdU_hpragma x_gnpragma `thenUgn` \ y_gnpragma ->
  40         returnUgn (U_nbind y_gnbindid y_gnbindas y_gnline y_gnpragma)
  41     else if tag == ``pbind'' then
  42         ioToUgnM (_ccall_ gpbindl t) `thenUgn` \ x_gpbindl ->
  43         rdU_list x_gpbindl `thenUgn` \ y_gpbindl ->
  44         ioToUgnM (_ccall_ gpline t) `thenUgn` \ x_gpline ->
  45         rdU_long x_gpline `thenUgn` \ y_gpline ->
  46         returnUgn (U_pbind y_gpbindl y_gpline)
  47     else if tag == ``fbind'' then
  48         ioToUgnM (_ccall_ gfbindl t) `thenUgn` \ x_gfbindl ->
  49         rdU_list x_gfbindl `thenUgn` \ y_gfbindl ->
  50         ioToUgnM (_ccall_ gfline t) `thenUgn` \ x_gfline ->
  51         rdU_long x_gfline `thenUgn` \ y_gfline ->
  52         returnUgn (U_fbind y_gfbindl y_gfline)
  53     else if tag == ``abind'' then
  54         ioToUgnM (_ccall_ gabindfst t) `thenUgn` \ x_gabindfst ->
  55         rdU_binding x_gabindfst `thenUgn` \ y_gabindfst ->
  56         ioToUgnM (_ccall_ gabindsnd t) `thenUgn` \ x_gabindsnd ->
  57         rdU_binding x_gabindsnd `thenUgn` \ y_gabindsnd ->
  58         returnUgn (U_abind y_gabindfst y_gabindsnd)
  59     else if tag == ``lbind'' then
  60         ioToUgnM (_ccall_ glbindfst t) `thenUgn` \ x_glbindfst ->
  61         rdU_binding x_glbindfst `thenUgn` \ y_glbindfst ->
  62         ioToUgnM (_ccall_ glbindsnd t) `thenUgn` \ x_glbindsnd ->
  63         rdU_binding x_glbindsnd `thenUgn` \ y_glbindsnd ->
  64         returnUgn (U_lbind y_glbindfst y_glbindsnd)
  65     else if tag == ``ebind'' then
  66         ioToUgnM (_ccall_ gebindl t) `thenUgn` \ x_gebindl ->
  67         rdU_list x_gebindl `thenUgn` \ y_gebindl ->
  68         ioToUgnM (_ccall_ gebind t) `thenUgn` \ x_gebind ->
  69         rdU_binding x_gebind `thenUgn` \ y_gebind ->
  70         ioToUgnM (_ccall_ geline t) `thenUgn` \ x_geline ->
  71         rdU_long x_geline `thenUgn` \ y_geline ->
  72         returnUgn (U_ebind y_gebindl y_gebind y_geline)
  73     else if tag == ``hbind'' then
  74         ioToUgnM (_ccall_ ghbindl t) `thenUgn` \ x_ghbindl ->
  75         rdU_list x_ghbindl `thenUgn` \ y_ghbindl ->
  76         ioToUgnM (_ccall_ ghbind t) `thenUgn` \ x_ghbind ->
  77         rdU_binding x_ghbind `thenUgn` \ y_ghbind ->
  78         ioToUgnM (_ccall_ ghline t) `thenUgn` \ x_ghline ->
  79         rdU_long x_ghline `thenUgn` \ y_ghline ->
  80         returnUgn (U_hbind y_ghbindl y_ghbind y_ghline)
  81     else if tag == ``ibind'' then
  82         ioToUgnM (_ccall_ gibindc t) `thenUgn` \ x_gibindc ->
  83         rdU_list x_gibindc `thenUgn` \ y_gibindc ->
  84         ioToUgnM (_ccall_ gibindid t) `thenUgn` \ x_gibindid ->
  85         rdU_unkId x_gibindid `thenUgn` \ y_gibindid ->
  86         ioToUgnM (_ccall_ gibindi t) `thenUgn` \ x_gibindi ->
  87         rdU_ttype x_gibindi `thenUgn` \ y_gibindi ->
  88         ioToUgnM (_ccall_ gibindw t) `thenUgn` \ x_gibindw ->
  89         rdU_binding x_gibindw `thenUgn` \ y_gibindw ->
  90         ioToUgnM (_ccall_ giline t) `thenUgn` \ x_giline ->
  91         rdU_long x_giline `thenUgn` \ y_giline ->
  92         ioToUgnM (_ccall_ gipragma t) `thenUgn` \ x_gipragma ->
  93         rdU_hpragma x_gipragma `thenUgn` \ y_gipragma ->
  94         returnUgn (U_ibind y_gibindc y_gibindid y_gibindi y_gibindw y_giline y_gipragma)
  95     else if tag == ``dbind'' then
  96         ioToUgnM (_ccall_ gdbindts t) `thenUgn` \ x_gdbindts ->
  97         rdU_list x_gdbindts `thenUgn` \ y_gdbindts ->
  98         ioToUgnM (_ccall_ gdline t) `thenUgn` \ x_gdline ->
  99         rdU_long x_gdline `thenUgn` \ y_gdline ->
 100         returnUgn (U_dbind y_gdbindts y_gdline)
 101     else if tag == ``cbind'' then
 102         ioToUgnM (_ccall_ gcbindc t) `thenUgn` \ x_gcbindc ->
 103         rdU_list x_gcbindc `thenUgn` \ y_gcbindc ->
 104         ioToUgnM (_ccall_ gcbindid t) `thenUgn` \ x_gcbindid ->
 105         rdU_ttype x_gcbindid `thenUgn` \ y_gcbindid ->
 106         ioToUgnM (_ccall_ gcbindw t) `thenUgn` \ x_gcbindw ->
 107         rdU_binding x_gcbindw `thenUgn` \ y_gcbindw ->
 108         ioToUgnM (_ccall_ gcline t) `thenUgn` \ x_gcline ->
 109         rdU_long x_gcline `thenUgn` \ y_gcline ->
 110         ioToUgnM (_ccall_ gcpragma t) `thenUgn` \ x_gcpragma ->
 111         rdU_hpragma x_gcpragma `thenUgn` \ y_gcpragma ->
 112         returnUgn (U_cbind y_gcbindc y_gcbindid y_gcbindw y_gcline y_gcpragma)
 113     else if tag == ``sbind'' then
 114         ioToUgnM (_ccall_ gsbindids t) `thenUgn` \ x_gsbindids ->
 115         rdU_list x_gsbindids `thenUgn` \ y_gsbindids ->
 116         ioToUgnM (_ccall_ gsbindid t) `thenUgn` \ x_gsbindid ->
 117         rdU_ttype x_gsbindid `thenUgn` \ y_gsbindid ->
 118         ioToUgnM (_ccall_ gsline t) `thenUgn` \ x_gsline ->
 119         rdU_long x_gsline `thenUgn` \ y_gsline ->
 120         ioToUgnM (_ccall_ gspragma t) `thenUgn` \ x_gspragma ->
 121         rdU_hpragma x_gspragma `thenUgn` \ y_gspragma ->
 122         returnUgn (U_sbind y_gsbindids y_gsbindid y_gsline y_gspragma)
 123     else if tag == ``mbind'' then
 124         ioToUgnM (_ccall_ gmbindmodn t) `thenUgn` \ x_gmbindmodn ->
 125         rdU_stringId x_gmbindmodn `thenUgn` \ y_gmbindmodn ->
 126         ioToUgnM (_ccall_ gmbindimp t) `thenUgn` \ x_gmbindimp ->
 127         rdU_list x_gmbindimp `thenUgn` \ y_gmbindimp ->
 128         ioToUgnM (_ccall_ gmbindren t) `thenUgn` \ x_gmbindren ->
 129         rdU_list x_gmbindren `thenUgn` \ y_gmbindren ->
 130         ioToUgnM (_ccall_ gmline t) `thenUgn` \ x_gmline ->
 131         rdU_long x_gmline `thenUgn` \ y_gmline ->
 132         returnUgn (U_mbind y_gmbindmodn y_gmbindimp y_gmbindren y_gmline)
 133     else if tag == ``nullbind'' then
 134         returnUgn (U_nullbind )
 135     else if tag == ``import'' then
 136         ioToUgnM (_ccall_ giebindmod t) `thenUgn` \ x_giebindmod ->
 137         rdU_stringId x_giebindmod `thenUgn` \ y_giebindmod ->
 138         ioToUgnM (_ccall_ giebindexp t) `thenUgn` \ x_giebindexp ->
 139         rdU_list x_giebindexp `thenUgn` \ y_giebindexp ->
 140         ioToUgnM (_ccall_ giebindren t) `thenUgn` \ x_giebindren ->
 141         rdU_list x_giebindren `thenUgn` \ y_giebindren ->
 142         ioToUgnM (_ccall_ giebinddef t) `thenUgn` \ x_giebinddef ->
 143         rdU_binding x_giebinddef `thenUgn` \ y_giebinddef ->
 144         ioToUgnM (_ccall_ giebindfile t) `thenUgn` \ x_giebindfile ->
 145         rdU_stringId x_giebindfile `thenUgn` \ y_giebindfile ->
 146         ioToUgnM (_ccall_ giebindline t) `thenUgn` \ x_giebindline ->
 147         rdU_long x_giebindline `thenUgn` \ y_giebindline ->
 148         returnUgn (U_import y_giebindmod y_giebindexp y_giebindren y_giebinddef y_giebindfile y_giebindline)
 149     else if tag == ``hiding'' then
 150         ioToUgnM (_ccall_ gihbindmod t) `thenUgn` \ x_gihbindmod ->
 151         rdU_stringId x_gihbindmod `thenUgn` \ y_gihbindmod ->
 152         ioToUgnM (_ccall_ gihbindexp t) `thenUgn` \ x_gihbindexp ->
 153         rdU_list x_gihbindexp `thenUgn` \ y_gihbindexp ->
 154         ioToUgnM (_ccall_ gihbindren t) `thenUgn` \ x_gihbindren ->
 155         rdU_list x_gihbindren `thenUgn` \ y_gihbindren ->
 156         ioToUgnM (_ccall_ gihbinddef t) `thenUgn` \ x_gihbinddef ->
 157         rdU_binding x_gihbinddef `thenUgn` \ y_gihbinddef ->
 158         ioToUgnM (_ccall_ gihbindfile t) `thenUgn` \ x_gihbindfile ->
 159         rdU_stringId x_gihbindfile `thenUgn` \ y_gihbindfile ->
 160         ioToUgnM (_ccall_ gihbindline t) `thenUgn` \ x_gihbindline ->
 161         rdU_long x_gihbindline `thenUgn` \ y_gihbindline ->
 162         returnUgn (U_hiding y_gihbindmod y_gihbindexp y_gihbindren y_gihbinddef y_gihbindfile y_gihbindline)
 163     else if tag == ``vspec_uprag'' then
 164         ioToUgnM (_ccall_ gvspec_id t) `thenUgn` \ x_gvspec_id ->
 165         rdU_unkId x_gvspec_id `thenUgn` \ y_gvspec_id ->
 166         ioToUgnM (_ccall_ gvspec_tys t) `thenUgn` \ x_gvspec_tys ->
 167         rdU_list x_gvspec_tys `thenUgn` \ y_gvspec_tys ->
 168         ioToUgnM (_ccall_ gvspec_line t) `thenUgn` \ x_gvspec_line ->
 169         rdU_long x_gvspec_line `thenUgn` \ y_gvspec_line ->
 170         returnUgn (U_vspec_uprag y_gvspec_id y_gvspec_tys y_gvspec_line)
 171     else if tag == ``vspec_ty_and_id'' then
 172         ioToUgnM (_ccall_ gvspec_ty t) `thenUgn` \ x_gvspec_ty ->
 173         rdU_ttype x_gvspec_ty `thenUgn` \ y_gvspec_ty ->
 174         ioToUgnM (_ccall_ gvspec_tyid t) `thenUgn` \ x_gvspec_tyid ->
 175         rdU_list x_gvspec_tyid `thenUgn` \ y_gvspec_tyid ->
 176         returnUgn (U_vspec_ty_and_id y_gvspec_ty y_gvspec_tyid)
 177     else if tag == ``ispec_uprag'' then
 178         ioToUgnM (_ccall_ gispec_clas t) `thenUgn` \ x_gispec_clas ->
 179         rdU_unkId x_gispec_clas `thenUgn` \ y_gispec_clas ->
 180         ioToUgnM (_ccall_ gispec_ty t) `thenUgn` \ x_gispec_ty ->
 181         rdU_ttype x_gispec_ty `thenUgn` \ y_gispec_ty ->
 182         ioToUgnM (_ccall_ gispec_line t) `thenUgn` \ x_gispec_line ->
 183         rdU_long x_gispec_line `thenUgn` \ y_gispec_line ->
 184         returnUgn (U_ispec_uprag y_gispec_clas y_gispec_ty y_gispec_line)
 185     else if tag == ``inline_uprag'' then
 186         ioToUgnM (_ccall_ ginline_id t) `thenUgn` \ x_ginline_id ->
 187         rdU_unkId x_ginline_id `thenUgn` \ y_ginline_id ->
 188         ioToUgnM (_ccall_ ginline_howto t) `thenUgn` \ x_ginline_howto ->
 189         rdU_list x_ginline_howto `thenUgn` \ y_ginline_howto ->
 190         ioToUgnM (_ccall_ ginline_line t) `thenUgn` \ x_ginline_line ->
 191         rdU_long x_ginline_line `thenUgn` \ y_ginline_line ->
 192         returnUgn (U_inline_uprag y_ginline_id y_ginline_howto y_ginline_line)
 193     else if tag == ``deforest_uprag'' then
 194         ioToUgnM (_ccall_ gdeforest_id t) `thenUgn` \ x_gdeforest_id ->
 195         rdU_unkId x_gdeforest_id `thenUgn` \ y_gdeforest_id ->
 196         ioToUgnM (_ccall_ gdeforest_line t) `thenUgn` \ x_gdeforest_line ->
 197         rdU_long x_gdeforest_line `thenUgn` \ y_gdeforest_line ->
 198         returnUgn (U_deforest_uprag y_gdeforest_id y_gdeforest_line)
 199     else if tag == ``magicuf_uprag'' then
 200         ioToUgnM (_ccall_ gmagicuf_id t) `thenUgn` \ x_gmagicuf_id ->
 201         rdU_unkId x_gmagicuf_id `thenUgn` \ y_gmagicuf_id ->
 202         ioToUgnM (_ccall_ gmagicuf_str t) `thenUgn` \ x_gmagicuf_str ->
 203         rdU_stringId x_gmagicuf_str `thenUgn` \ y_gmagicuf_str ->
 204         ioToUgnM (_ccall_ gmagicuf_line t) `thenUgn` \ x_gmagicuf_line ->
 205         rdU_long x_gmagicuf_line `thenUgn` \ y_gmagicuf_line ->
 206         returnUgn (U_magicuf_uprag y_gmagicuf_id y_gmagicuf_str y_gmagicuf_line)
 207     else if tag == ``abstract_uprag'' then
 208         ioToUgnM (_ccall_ gabstract_id t) `thenUgn` \ x_gabstract_id ->
 209         rdU_unkId x_gabstract_id `thenUgn` \ y_gabstract_id ->
 210         ioToUgnM (_ccall_ gabstract_line t) `thenUgn` \ x_gabstract_line ->
 211         rdU_long x_gabstract_line `thenUgn` \ y_gabstract_line ->
 212         returnUgn (U_abstract_uprag y_gabstract_id y_gabstract_line)
 213     else if tag == ``dspec_uprag'' then
 214         ioToUgnM (_ccall_ gdspec_id t) `thenUgn` \ x_gdspec_id ->
 215         rdU_unkId x_gdspec_id `thenUgn` \ y_gdspec_id ->
 216         ioToUgnM (_ccall_ gdspec_tys t) `thenUgn` \ x_gdspec_tys ->
 217         rdU_list x_gdspec_tys `thenUgn` \ y_gdspec_tys ->
 218         ioToUgnM (_ccall_ gdspec_line t) `thenUgn` \ x_gdspec_line ->
 219         rdU_long x_gdspec_line `thenUgn` \ y_gdspec_line ->
 220         returnUgn (U_dspec_uprag y_gdspec_id y_gdspec_tys y_gdspec_line)
 221     else
 222         error ("rdU_binding: bad tag selection:"++show tag++"\n")