ghc/compiler/yaccParser/U_ttype.hs

   1
   2
   3 module U_ttype where
   4 import UgenUtil
   5 import Util
   6
   7 import U_list
   8 data U_ttype = U_tname U_unkId U_list | U_namedtvar U_unkId | U_tllist U_ttype | U_ttuple U_list | U_tfun U_ttype U_ttype | U_context U_list U_ttype | U_unidict U_unkId U_ttype | U_unityvartemplate U_unkId | U_uniforall U_list U_ttype | U_ty_maybe_nothing | U_ty_maybe_just U_ttype
   9
  10 rdU_ttype :: _Addr -> UgnM U_ttype
  11 rdU_ttype t
  12   = ioToUgnM (_ccall_ tttype t) `thenUgn` \ tag@(I# _) ->
  13     if tag == ``tname'' then
  14         ioToUgnM (_ccall_ gtypeid t) `thenUgn` \ x_gtypeid ->
  15         rdU_unkId x_gtypeid `thenUgn` \ y_gtypeid ->
  16         ioToUgnM (_ccall_ gtypel t) `thenUgn` \ x_gtypel ->
  17         rdU_list x_gtypel `thenUgn` \ y_gtypel ->
  18         returnUgn (U_tname y_gtypeid y_gtypel)
  19     else if tag == ``namedtvar'' then
  20         ioToUgnM (_ccall_ gnamedtvar t) `thenUgn` \ x_gnamedtvar ->
  21         rdU_unkId x_gnamedtvar `thenUgn` \ y_gnamedtvar ->
  22         returnUgn (U_namedtvar y_gnamedtvar)
  23     else if tag == ``tllist'' then
  24         ioToUgnM (_ccall_ gtlist t) `thenUgn` \ x_gtlist ->
  25         rdU_ttype x_gtlist `thenUgn` \ y_gtlist ->
  26         returnUgn (U_tllist y_gtlist)
  27     else if tag == ``ttuple'' then
  28         ioToUgnM (_ccall_ gttuple t) `thenUgn` \ x_gttuple ->
  29         rdU_list x_gttuple `thenUgn` \ y_gttuple ->
  30         returnUgn (U_ttuple y_gttuple)
  31     else if tag == ``tfun'' then
  32         ioToUgnM (_ccall_ gtfun t) `thenUgn` \ x_gtfun ->
  33         rdU_ttype x_gtfun `thenUgn` \ y_gtfun ->
  34         ioToUgnM (_ccall_ gtarg t) `thenUgn` \ x_gtarg ->
  35         rdU_ttype x_gtarg `thenUgn` \ y_gtarg ->
  36         returnUgn (U_tfun y_gtfun y_gtarg)
  37     else if tag == ``context'' then
  38         ioToUgnM (_ccall_ gtcontextl t) `thenUgn` \ x_gtcontextl ->
  39         rdU_list x_gtcontextl `thenUgn` \ y_gtcontextl ->
  40         ioToUgnM (_ccall_ gtcontextt t) `thenUgn` \ x_gtcontextt ->
  41         rdU_ttype x_gtcontextt `thenUgn` \ y_gtcontextt ->
  42         returnUgn (U_context y_gtcontextl y_gtcontextt)
  43     else if tag == ``unidict'' then
  44         ioToUgnM (_ccall_ gunidict_clas t) `thenUgn` \ x_gunidict_clas ->
  45         rdU_unkId x_gunidict_clas `thenUgn` \ y_gunidict_clas ->
  46         ioToUgnM (_ccall_ gunidict_ty t) `thenUgn` \ x_gunidict_ty ->
  47         rdU_ttype x_gunidict_ty `thenUgn` \ y_gunidict_ty ->
  48         returnUgn (U_unidict y_gunidict_clas y_gunidict_ty)
  49     else if tag == ``unityvartemplate'' then
  50         ioToUgnM (_ccall_ gunityvartemplate t) `thenUgn` \ x_gunityvartemplate ->
  51         rdU_unkId x_gunityvartemplate `thenUgn` \ y_gunityvartemplate ->
  52         returnUgn (U_unityvartemplate y_gunityvartemplate)
  53     else if tag == ``uniforall'' then
  54         ioToUgnM (_ccall_ guniforall_tv t) `thenUgn` \ x_guniforall_tv ->
  55         rdU_list x_guniforall_tv `thenUgn` \ y_guniforall_tv ->
  56         ioToUgnM (_ccall_ guniforall_ty t) `thenUgn` \ x_guniforall_ty ->
  57         rdU_ttype x_guniforall_ty `thenUgn` \ y_guniforall_ty ->
  58         returnUgn (U_uniforall y_guniforall_tv y_guniforall_ty)
  59     else if tag == ``ty_maybe_nothing'' then
  60         returnUgn (U_ty_maybe_nothing )
  61     else if tag == ``ty_maybe_just'' then
  62         ioToUgnM (_ccall_ gty_maybe t) `thenUgn` \ x_gty_maybe ->
  63         rdU_ttype x_gty_maybe `thenUgn` \ y_gty_maybe ->
  64         returnUgn (U_ty_maybe_just y_gty_maybe)
  65     else
  66         error ("rdU_ttype: bad tag selection:"++show tag++"\n")