ghc/compiler/yaccParser/U_entidt.hs

   1
   2
   3 module U_entidt where
   4 import UgenUtil
   5 import Util
   6
   7 import U_list
   8 data U_entidt = U_entid U_stringId | U_enttype U_stringId | U_enttypeall U_stringId | U_enttypecons U_stringId U_list | U_entclass U_stringId U_list | U_entmod U_stringId
   9
  10 rdU_entidt :: _Addr -> UgnM U_entidt
  11 rdU_entidt t
  12   = ioToUgnM (_ccall_ tentidt t) `thenUgn` \ tag@(I# _) ->
  13     if tag == ``entid'' then
  14         ioToUgnM (_ccall_ gentid t) `thenUgn` \ x_gentid ->
  15         rdU_stringId x_gentid `thenUgn` \ y_gentid ->
  16         returnUgn (U_entid y_gentid)
  17     else if tag == ``enttype'' then
  18         ioToUgnM (_ccall_ gitentid t) `thenUgn` \ x_gitentid ->
  19         rdU_stringId x_gitentid `thenUgn` \ y_gitentid ->
  20         returnUgn (U_enttype y_gitentid)
  21     else if tag == ``enttypeall'' then
  22         ioToUgnM (_ccall_ gatentid t) `thenUgn` \ x_gatentid ->
  23         rdU_stringId x_gatentid `thenUgn` \ y_gatentid ->
  24         returnUgn (U_enttypeall y_gatentid)
  25     else if tag == ``enttypecons'' then
  26         ioToUgnM (_ccall_ gctentid t) `thenUgn` \ x_gctentid ->
  27         rdU_stringId x_gctentid `thenUgn` \ y_gctentid ->
  28         ioToUgnM (_ccall_ gctentcons t) `thenUgn` \ x_gctentcons ->
  29         rdU_list x_gctentcons `thenUgn` \ y_gctentcons ->
  30         returnUgn (U_enttypecons y_gctentid y_gctentcons)
  31     else if tag == ``entclass'' then
  32         ioToUgnM (_ccall_ gcentid t) `thenUgn` \ x_gcentid ->
  33         rdU_stringId x_gcentid `thenUgn` \ y_gcentid ->
  34         ioToUgnM (_ccall_ gcentops t) `thenUgn` \ x_gcentops ->
  35         rdU_list x_gcentops `thenUgn` \ y_gcentops ->
  36         returnUgn (U_entclass y_gcentid y_gcentops)
  37     else if tag == ``entmod'' then
  38         ioToUgnM (_ccall_ gmentid t) `thenUgn` \ x_gmentid ->
  39         rdU_stringId x_gmentid `thenUgn` \ y_gmentid ->
  40         returnUgn (U_entmod y_gmentid)
  41     else
  42         error ("rdU_entidt: bad tag selection:"++show tag++"\n")