\begin{code}
#include "HsVersions.h"
-module ReadPrefix (
- rdModule
- ) where
+module ReadPrefix ( rdModule ) where
-import Ubiq
+IMP_Ubiq()
import UgenAll -- all Yacc parser gumpff...
import PrefixSyn -- and various syntaxen.
import RdrHsSyn
import PrefixToHs
-import CmdLineOpts ( opt_CompilingPrelude )
import ErrUtils ( addErrLoc, ghcExit )
import FiniteMap ( elemFM, FiniteMap )
-import Name ( RdrName(..), isRdrLexConOrSpecial )
+import Name ( RdrName(..), isRdrLexConOrSpecial, preludeQual )
import PprStyle ( PprStyle(..) )
-import PrelMods ( fromPrelude )
+import PrelMods ( pRELUDE )
import Pretty
import SrcLoc ( SrcLoc )
import Util ( nOfThem, pprError, panic )
wlkQid (U_noqual name)
= returnUgn (Unqual name)
wlkQid (U_aqual mod name)
- | fromPrelude mod
- = returnUgn (Unqual name)
- | otherwise
= returnUgn (Qual mod name)
wlkQid (U_gid n name)
- = returnUgn (Unqual name)
+ = returnUgn (preludeQual name)
cvFlag :: U_long -> Bool
cvFlag 0 = False
U_negate nexp -> -- prefix negation
wlkExpr nexp `thenUgn` \ expr ->
- returnUgn (NegApp expr (Unqual SLIT("negate")) )
+ -- this is a hack
+ let
+ rdr = preludeQual SLIT("negate")
+ in
+ returnUgn (NegApp expr (HsVar rdr))
U_llist llist -> -- explicit list
wlkList rdExpr llist `thenUgn` \ exprs ->
= case pat of
U_par ppat -> -- parenthesised pattern
wlkPat ppat `thenUgn` \ pat ->
- returnUgn (ParPatIn pat)
+ -- tidy things up a little:
+ returnUgn (
+ case pat of
+ VarPatIn _ -> pat
+ WildPatIn -> pat
+ other -> ParPatIn pat
+ )
U_as avar as_pat -> -- "as" pattern
wlkQid avar `thenUgn` \ var ->
wlkLiteral ulit
= returnUgn (
case ulit of
- U_integer s -> HsInt (as_integer s)
+ U_integer s -> HsInt (as_integer s)
U_floatr s -> HsFrac (as_rational s)
U_intprim s -> HsIntPrim (as_integer s)
U_doubleprim s -> HsDoublePrim (as_rational s)
binds = cvMonoBinds sf bs
uprags = concat (map cvInstDeclSig ss)
ctxt_inst_ty = HsPreForAllTy ctxt inst_ty
- maybe_mod = if opt_CompilingPrelude
- then Nothing
- else Just modname
in
returnUgn (RdrInstDecl
- (InstDecl clas ctxt_inst_ty binds True maybe_mod uprags noInstancePragmas src_loc))
+ (InstDecl clas ctxt_inst_ty binds True modname uprags noInstancePragmas src_loc))
-- "default" declaration
U_dbind dbindts srcline ->