import ErrUtils ( Message )
import Id ( Id, mkLocalId, mkExportedLocalId )
#if alpha_TARGET_ARCH
-import PrimRep ( getPrimRepSize, isFloatingRep )
import Type ( typePrimRep )
+import SMRep ( argMachRep, primRepToCgRep, primRepHint )
#endif
import OccName ( mkForeignExportOcc )
import Name ( Name, NamedThing(..), mkExternalName )
CLabelString, isCLabelString,
isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) )
import PrelNames ( hasKey, ioTyConKey )
-import CmdLineOpts ( dopt_HscTarget, HscTarget(..) )
+import DynFlags ( DynFlags(..), HscTarget(..) )
import Outputable
import SrcLoc ( Located(..), srcSpanStart )
import Bag ( consBag )
#if alpha_TARGET_ARCH
-import MachOp ( machRepByteWidth )
+import MachOp ( machRepByteWidth, MachHint(FloatHint) )
#endif
\end{code}
checkFEDArgs arg_tys
= check (integral_args <= 32) err
where
- integral_args = sum [ machRepByteWidth rep
- | (rep,hint) <- map typeMachRepRep arg_tys,
- hint /= FloatHint ]
- err = ptext SLIT("On Alpha, I can only handle 4 non-floating-point arguments to foreign export dynamic")
+ integral_args = sum [ (machRepByteWidth . 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")
#else
checkFEDArgs arg_tys = returnM ()
#endif
checkCg check
= getDOpts `thenM` \ dflags ->
- let hscTarget = dopt_HscTarget dflags in
- case hscTarget of
+ let target = hscTarget dflags in
+ case target of
HscNothing -> returnM ()
otherwise ->
- case check hscTarget of
+ case check target of
Nothing -> returnM ()
Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
\end{code}