ghc/compiler/yaccParser/U_literal.hs

   1
   2
   3 module U_literal where
   4 import UgenUtil
   5 import Util
   6 data U_literal = U_integer U_stringId | U_intprim U_stringId | U_floatr U_stringId | U_doubleprim U_stringId | U_floatprim U_stringId | U_charr U_hstring | U_charprim U_hstring | U_string U_hstring | U_stringprim U_hstring | U_clitlit U_stringId U_stringId | U_norepi U_stringId | U_norepr U_stringId U_stringId | U_noreps U_hstring
   7
   8 rdU_literal :: _Addr -> UgnM U_literal
   9 rdU_literal t
  10   = ioToUgnM (_ccall_ tliteral t) `thenUgn` \ tag@(I# _) ->
  11     if tag == ``integer'' then
  12         ioToUgnM (_ccall_ ginteger t) `thenUgn` \ x_ginteger ->
  13         rdU_stringId x_ginteger `thenUgn` \ y_ginteger ->
  14         returnUgn (U_integer y_ginteger)
  15     else if tag == ``intprim'' then
  16         ioToUgnM (_ccall_ gintprim t) `thenUgn` \ x_gintprim ->
  17         rdU_stringId x_gintprim `thenUgn` \ y_gintprim ->
  18         returnUgn (U_intprim y_gintprim)
  19     else if tag == ``floatr'' then
  20         ioToUgnM (_ccall_ gfloatr t) `thenUgn` \ x_gfloatr ->
  21         rdU_stringId x_gfloatr `thenUgn` \ y_gfloatr ->
  22         returnUgn (U_floatr y_gfloatr)
  23     else if tag == ``doubleprim'' then
  24         ioToUgnM (_ccall_ gdoubleprim t) `thenUgn` \ x_gdoubleprim ->
  25         rdU_stringId x_gdoubleprim `thenUgn` \ y_gdoubleprim ->
  26         returnUgn (U_doubleprim y_gdoubleprim)
  27     else if tag == ``floatprim'' then
  28         ioToUgnM (_ccall_ gfloatprim t) `thenUgn` \ x_gfloatprim ->
  29         rdU_stringId x_gfloatprim `thenUgn` \ y_gfloatprim ->
  30         returnUgn (U_floatprim y_gfloatprim)
  31     else if tag == ``charr'' then
  32         ioToUgnM (_ccall_ gchar t) `thenUgn` \ x_gchar ->
  33         rdU_hstring x_gchar `thenUgn` \ y_gchar ->
  34         returnUgn (U_charr y_gchar)
  35     else if tag == ``charprim'' then
  36         ioToUgnM (_ccall_ gcharprim t) `thenUgn` \ x_gcharprim ->
  37         rdU_hstring x_gcharprim `thenUgn` \ y_gcharprim ->
  38         returnUgn (U_charprim y_gcharprim)
  39     else if tag == ``string'' then
  40         ioToUgnM (_ccall_ gstring t) `thenUgn` \ x_gstring ->
  41         rdU_hstring x_gstring `thenUgn` \ y_gstring ->
  42         returnUgn (U_string y_gstring)
  43     else if tag == ``stringprim'' then
  44         ioToUgnM (_ccall_ gstringprim t) `thenUgn` \ x_gstringprim ->
  45         rdU_hstring x_gstringprim `thenUgn` \ y_gstringprim ->
  46         returnUgn (U_stringprim y_gstringprim)
  47     else if tag == ``clitlit'' then
  48         ioToUgnM (_ccall_ gclitlit t) `thenUgn` \ x_gclitlit ->
  49         rdU_stringId x_gclitlit `thenUgn` \ y_gclitlit ->
  50         ioToUgnM (_ccall_ gclitlit_kind t) `thenUgn` \ x_gclitlit_kind ->
  51         rdU_stringId x_gclitlit_kind `thenUgn` \ y_gclitlit_kind ->
  52         returnUgn (U_clitlit y_gclitlit y_gclitlit_kind)
  53     else if tag == ``norepi'' then
  54         ioToUgnM (_ccall_ gnorepi t) `thenUgn` \ x_gnorepi ->
  55         rdU_stringId x_gnorepi `thenUgn` \ y_gnorepi ->
  56         returnUgn (U_norepi y_gnorepi)
  57     else if tag == ``norepr'' then
  58         ioToUgnM (_ccall_ gnorepr_n t) `thenUgn` \ x_gnorepr_n ->
  59         rdU_stringId x_gnorepr_n `thenUgn` \ y_gnorepr_n ->
  60         ioToUgnM (_ccall_ gnorepr_d t) `thenUgn` \ x_gnorepr_d ->
  61         rdU_stringId x_gnorepr_d `thenUgn` \ y_gnorepr_d ->
  62         returnUgn (U_norepr y_gnorepr_n y_gnorepr_d)
  63     else if tag == ``noreps'' then
  64         ioToUgnM (_ccall_ gnoreps t) `thenUgn` \ x_gnoreps ->
  65         rdU_hstring x_gnoreps `thenUgn` \ y_gnoreps ->
  66         returnUgn (U_noreps y_gnoreps)
  67     else
  68         error ("rdU_literal: bad tag selection:"++show tag++"\n")