X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;h=b1dda2d715cc2e0cff1507c65bfaca6a37c0a4aa;hb=b5bb34f029d3f68d966c0b9ed79305e3d9aac98c;hp=bbf181c03df74b76c7f0f5fe26286779bbe8c76c;hpb=3b6382e443ed57d08dc676337621fc3d5cd0cb05;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index bbf181c..b1dda2d 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -25,6 +25,7 @@ import HsSyn import TcRnMonad import TcHsType import TcExpr +import TcEnv import ForeignCall import ErrUtils @@ -32,7 +33,6 @@ import Id #if alpha_TARGET_ARCH import Type import SMRep -import MachOp #endif import Name import OccName @@ -41,7 +41,6 @@ import DynFlags import Outputable import SrcLoc import Bag -import Unique import FastString \end{code} @@ -189,7 +188,7 @@ checkFEDArgs :: [Type] -> TcM () checkFEDArgs arg_tys = check (integral_args <= 32) err where - integral_args = sum [ (machRepByteWidth . argMachRep . primRepToCgRep) prim_rep + integral_args = sum [ (widthInBytes . argMachRep . primRepToCgRep) prim_rep | prim_rep <- map typePrimRep arg_tys, primRepHint prim_rep /= FloatHint ] err = ptext (sLit "On Alpha, I can only handle 32 bytes of non-floating-point arguments to foreign export dynamic") @@ -229,24 +228,12 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) = -- to create a local binding which will call the exported function -- at a particular type (and, maybe, overloading). - uniq <- newUnique - mod <- getModule - let - -- We need to give a name to the new top-level binding that - -- is *stable* (i.e. the compiler won't change it later), - -- because this name will be referred to by the C code stub. - -- Furthermore, the name must be unique (see #1533). If the - -- same function is foreign-exported multiple times, the - -- top-level bindings generated must not have the same name. - -- Hence we create an External name (doesn't change), and we - -- append a Unique to the string right here. - uniq_str = showSDoc (pprUnique uniq) - occ = mkVarOcc (occNameString (getOccName nm) ++ '_' : uniq_str) - gnm = mkExternalName uniq mod (mkForeignExportOcc occ) loc - id = mkExportedLocalId gnm sig_ty - bind = L loc (VarBind id rhs) - - return (bind, ForeignExport (L loc id) undefined spec) + + -- We need to give a name to the new top-level binding that + -- is *stable* (i.e. the compiler won't change it later), + -- because this name will be referred to by the C code stub. + id <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc + return (L loc (VarBind id rhs), ForeignExport (L loc id) undefined spec) tcFExport d = pprPanic "tcFExport" (ppr d) \end{code}