Commit 1fede4bc authored by Simon Marlow's avatar Simon Marlow

Remove old 'foreign import dotnet' code

It still lives in darcs, if anyone wants to revive it sometime.
parent dd849158
......@@ -94,9 +94,6 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
-- ToDo: this might not be correct for 64-bit API
arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE
emitForeignCall _ (DNCall _) _ _
= panic "emitForeignCall: DNCall"
-- alternative entry point, used by CmmParse
emitForeignCall'
......
......@@ -320,7 +320,6 @@ isSimpleScrut _ _ = False
isSimpleOp :: StgOp -> Bool
-- True iff the op cannot block or allocate
isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) = not (playSafe safe)
isSimpleOp (StgFCallOp (DNCall _) _) = False -- Safe!
isSimpleOp (StgPrimOp op) = not (primOpOutOfLine op)
isSimpleOp (StgPrimCallOp _) = False
......
......@@ -82,9 +82,6 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
-- ToDo: this might not be correct for 64-bit API
arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType arg) wORD_SIZE
cgForeignCall _ _ (DNCall _) _
= panic "cgForeignCall: DNCall"
emitCCall :: [(CmmFormal,ForeignHint)]
-> CmmExpr
-> [(CmmActual,ForeignHint)]
......
......@@ -88,7 +88,7 @@ dsCCall :: CLabelString -- C routine to invoke
dsCCall lbl args may_gc result_ty
= do (unboxed_args, arg_wrappers) <- mapAndUnzipM unboxArg args
(ccall_result_ty, res_wrapper) <- boxResult id Nothing result_ty
(ccall_result_ty, res_wrapper) <- boxResult result_ty
uniq <- newUnique
let
target = StaticTarget lbl
......@@ -231,10 +231,7 @@ unboxArg arg
\begin{code}
boxResult :: ((Maybe Type, CoreExpr -> CoreExpr)
-> (Maybe Type, CoreExpr -> CoreExpr))
-> Maybe Id
-> Type
boxResult :: Type
-> DsM (Type, CoreExpr -> CoreExpr)
-- Takes the result of the user-level ccall:
......@@ -247,11 +244,8 @@ boxResult :: ((Maybe Type, CoreExpr -> CoreExpr)
-- where t' is the unwrapped form of t. If t is simply (), then
-- the result type will be
-- State# RealWorld -> (# State# RealWorld #)
--
-- The gruesome 'augment' and 'mbTopCon' are to do with .NET foreign calls
-- It looks a mess: I wonder if it could be refactored.
boxResult augment mbTopCon result_ty
boxResult result_ty
| Just (io_tycon, io_res_ty, co) <- tcSplitIOType_maybe result_ty
-- isIOType_maybe handles the case where the type is a
-- simple wrapping of IO. E.g.
......@@ -261,9 +255,8 @@ boxResult augment mbTopCon result_ty
-- another case, and a coercion.)
-- The result is IO t, so wrap the result in an IO constructor
= do { res <- resultWrapper io_res_ty
; let aug_res = augment res
extra_result_tys
= case aug_res of
; let extra_result_tys
= case res of
(Just ty,_)
| isUnboxedTupleType ty
-> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls
......@@ -274,11 +267,11 @@ boxResult augment mbTopCon result_ty
(map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
++ (state : anss))
; (ccall_res_ty, the_alt) <- mk_alt return_result aug_res
; (ccall_res_ty, the_alt) <- mk_alt return_result res
; state_id <- newSysLocalDs realWorldStatePrimTy
; let io_data_con = head (tyConDataCons io_tycon)
toIOCon = mbTopCon `orElse` dataConWrapId io_data_con
toIOCon = dataConWrapId io_data_con
wrap the_call = mkCoerceI (mkSymCoI co) $
mkApps (Var toIOCon)
......@@ -292,11 +285,11 @@ boxResult augment mbTopCon result_ty
; return (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) }
boxResult augment _mbTopCon result_ty
boxResult result_ty
= do -- It isn't IO, so do unsafePerformIO
-- It's not conveniently available, so we inline it
res <- resultWrapper result_ty
(ccall_res_ty, the_alt) <- mk_alt return_result (augment res)
(ccall_res_ty, the_alt) <- mk_alt return_result res
let
wrap = \ the_call -> mkWildCase (App the_call (Var realWorldPrimId))
ccall_res_ty
......
......@@ -128,13 +128,6 @@ dsFImport id (CImport cconv safety _ spec) = do
(ids, h, c) <- dsCImport id spec cconv safety
return (ids, h, c)
-- FIXME: the `lib' field is needed for .NET ILX generation when invoking
-- routines that are external to the .NET runtime, but GHC doesn't
-- support such calls yet; if `nullFastString lib', the value was not given
dsFImport id (DNImport spec) = do
(ids, h, c) <- dsFCall id (DNCall spec)
return (ids, h, c)
dsCImport :: Id
-> CImportSpec
-> CCallConv
......@@ -200,30 +193,7 @@ dsFCall fn_id fcall = do
let
work_arg_ids = [v | Var v <- val_args] -- All guaranteed to be vars
forDotnet =
case fcall of
DNCall{} -> True
_ -> False
topConDs
| forDotnet = Just <$> dsLookupGlobalId checkDotnetResName
| otherwise = return Nothing
augmentResultDs
| forDotnet = do
return (\ (mb_res_ty, resWrap) ->
case mb_res_ty of
Nothing -> (Just (mkTyConApp (tupleTyCon Unboxed 1)
[ addrPrimTy ]),
resWrap)
Just x -> (Just (mkTyConApp (tupleTyCon Unboxed 2)
[ x, addrPrimTy ]),
resWrap))
| otherwise = return id
augment <- augmentResultDs
topCon <- topConDs
(ccall_result_ty, res_wrapper) <- boxResult augment topCon io_res_ty
(ccall_result_ty, res_wrapper) <- boxResult io_res_ty
ccall_uniq <- newUnique
work_uniq <- newUnique
......
......@@ -39,7 +39,7 @@ module HsDecls (
SpliceDecl(..),
-- ** Foreign function interface declarations
ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
CImportSpec(..), FoType(..),
CImportSpec(..),
-- ** Data-constructor declarations
ConDecl(..), LConDecl, ResType(..),
HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
......@@ -401,8 +401,7 @@ type LTyClDecl name = Located (TyClDecl name)
data TyClDecl name
= ForeignType {
tcdLName :: Located name,
tcdExtName :: Maybe FastString,
tcdFoType :: FoType
tcdExtName :: Maybe FastString
}
......@@ -909,10 +908,6 @@ data ForeignImport = -- import of a C entity
FastString -- name of C header
CImportSpec -- details of the C entity
-- import of a .NET function
--
| DNImport DNCallSpec
-- details of an external C entity
--
data CImportSpec = CLabel CLabelString -- import address of a C label
......@@ -924,13 +919,6 @@ data CImportSpec = CLabel CLabelString -- import address of a C label
-- convention
--
data ForeignExport = CExport CExportSpec -- contains the calling convention
| DNExport -- presently unused
-- abstract type imported from .NET
--
data FoType = DNType -- In due course we'll add subtype stuff
deriving (Eq) -- Used for equality instance for TyClDecl
-- pretty printing of foreign declarations
--
......@@ -944,8 +932,6 @@ instance OutputableBndr name => Outputable (ForeignDecl name) where
2 (dcolon <+> ppr ty)
instance Outputable ForeignImport where
ppr (DNImport spec) =
ptext (sLit "dotnet") <+> ppr spec
ppr (CImport cconv safety header spec) =
ppr cconv <+> ppr safety <+>
char '"' <> pprCEntity spec <> char '"'
......@@ -963,11 +949,6 @@ instance Outputable ForeignImport where
instance Outputable ForeignExport where
ppr (CExport (CExportStatic lbl cconv)) =
ppr cconv <+> char '"' <> ppr lbl <> char '"'
ppr (DNExport ) =
ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
instance Outputable FoType where
ppr DNType = ptext (sLit "type dotnet")
\end{code}
......
......@@ -454,7 +454,6 @@ data Token
| ITstdcallconv
| ITccallconv
| ITprimcallconv
| ITdotnet
| ITmdo
| ITfamily
| ITgroup
......@@ -664,7 +663,6 @@ reservedWordsFM = listToUFM $
( "stdcall", ITstdcallconv, bit ffiBit),
( "ccall", ITccallconv, bit ffiBit),
( "prim", ITprimcallconv, bit ffiBit),
( "dotnet", ITdotnet, bit ffiBit),
( "rec", ITrec, bit arrowsBit),
( "proc", ITproc, bit arrowsBit)
......
......@@ -248,7 +248,6 @@ incorrect.
'stdcall' { L _ ITstdcallconv }
'ccall' { L _ ITccallconv }
'prim' { L _ ITprimcallconv }
'dotnet' { L _ ITdotnet }
'proc' { L _ ITproc } -- for arrow notation extension
'rec' { L _ ITrec } -- for arrow notation extension
'group' { L _ ITgroup } -- for list transform extension
......@@ -876,11 +875,10 @@ fdecl : 'import' callconv safety fspec
| 'export' callconv fspec
{% mkExport $2 (unLoc $3) >>= return.LL }
callconv :: { CallConv }
: 'stdcall' { CCall StdCallConv }
| 'ccall' { CCall CCallConv }
| 'prim' { CCall PrimCallConv}
| 'dotnet' { DNCall }
callconv :: { CCallConv }
: 'stdcall' { StdCallConv }
| 'ccall' { CCallConv }
| 'prim' { PrimCallConv}
safety :: { Safety }
: 'unsafe' { PlayRisky }
......
......@@ -21,14 +21,9 @@ module RdrHsSyn (
findSplice, checkDecBrGroup,
-- Stuff to do with Foreign declarations
CallConv(..),
mkImport, -- CallConv -> Safety
-- -> (FastString, RdrName, RdrNameHsType)
-- -> P RdrNameHsDecl
mkImport,
parseCImport,
mkExport, -- CallConv
-- -> (FastString, RdrName, RdrNameHsType)
-- -> P RdrNameHsDecl
mkExport,
mkExtName, -- RdrName -> CLabelString
mkGadtDecl, -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
mkSimpleConDecl,
......@@ -65,8 +60,7 @@ import BasicTypes ( maxPrecedence, Activation, RuleMatchInfo,
alwaysInlineSpec, neverInlineSpec )
import Lexer
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv(..), Safety, CCallTarget(..), CExportSpec(..),
DNCallSpec(..), DNKind(..), CLabelString )
import ForeignCall
import OccName ( srcDataName, varName, isDataOcc, isTcOcc,
occNameString )
import PrelNames ( forall_tv_RDR )
......@@ -972,18 +966,13 @@ mkInlineSpec (Just act) match_info inl = Inline (InlinePragma act match_info)
-----------------------------------------------------------------------------
-- utilities for foreign declarations
-- supported calling conventions
--
data CallConv = CCall CCallConv -- ccall or stdcall
| DNCall -- .NET
-- construct a foreign import declaration
--
mkImport :: CallConv
mkImport :: CCallConv
-> Safety
-> (Located FastString, Located RdrName, LHsType RdrName)
-> P (HsDecl RdrName)
mkImport (CCall cconv) safety (L loc entity, v, ty)
mkImport cconv safety (L loc entity, v, ty)
| cconv == PrimCallConv = do
let funcTarget = CFunction (StaticTarget entity)
importSpec = CImport PrimCallConv safety nilFS funcTarget
......@@ -992,9 +981,6 @@ mkImport (CCall cconv) safety (L loc entity, v, ty)
case parseCImport cconv safety (mkExtName (unLoc v)) (unpackFS entity) of
Nothing -> parseError loc "Malformed entity string"
Just importSpec -> return (ForD (ForeignImport v ty importSpec))
mkImport (DNCall ) _ (entity, v, ty) = do
spec <- parseDImport entity
return $ ForD (ForeignImport v ty (DNImport spec))
-- the string "foo" is ambigous: either a header or a C identifier. The
-- C identifier case comes first in the alternatives below, so we pick
......@@ -1027,56 +1013,16 @@ parseCImport cconv safety nm str =
return (mkFastString (c:cs)))
--
-- Unravel a dotnet spec string.
--
parseDImport :: Located FastString -> P DNCallSpec
parseDImport (L loc entity) = parse0 comps
where
comps = words (unpackFS entity)
parse0 [] = d'oh
parse0 (x : xs)
| x == "static" = parse1 True xs
| otherwise = parse1 False (x:xs)
parse1 _ [] = d'oh
parse1 isStatic (x:xs)
| x == "method" = parse2 isStatic DNMethod xs
| x == "field" = parse2 isStatic DNField xs
| x == "ctor" = parse2 isStatic DNConstructor xs
parse1 isStatic xs = parse2 isStatic DNMethod xs
parse2 _ _ [] = d'oh
parse2 isStatic kind (('[':x):xs) =
case x of
[] -> d'oh
vs | last vs == ']' -> parse3 isStatic kind (init vs) xs
_ -> d'oh
parse2 isStatic kind xs = parse3 isStatic kind "" xs
parse3 isStatic kind assem [x] =
return (DNCallSpec isStatic kind assem x
-- these will be filled in once known.
(error "FFI-dotnet-args")
(error "FFI-dotnet-result"))
parse3 _ _ _ _ = d'oh
d'oh = parseError loc "Malformed entity string"
-- construct a foreign export declaration
--
mkExport :: CallConv
mkExport :: CCallConv
-> (Located FastString, Located RdrName, LHsType RdrName)
-> P (HsDecl RdrName)
mkExport (CCall cconv) (L _ entity, v, ty) = return $
mkExport cconv (L _ entity, v, ty) = return $
ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)))
where
entity' | nullFS entity = mkExtName (unLoc v)
| otherwise = entity
mkExport DNCall (L _ _, v, _) =
parseError (getLoc v){-TODO: not quite right-}
"Foreign export is not yet supported for .NET"
-- Supplying the ext_name in a foreign decl is optional; if it
-- isn't there, the Haskell name is assumed. Note that no transformation
......
......@@ -19,9 +19,6 @@ module ForeignCall (
CCallSpec(..),
CCallTarget(..), isDynamicTarget,
CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
DNCallSpec(..), DNKind(..), DNType(..),
withDNTypes
) where
import FastString
......@@ -39,18 +36,14 @@ import Data.Char
%************************************************************************
\begin{code}
data ForeignCall
= CCall CCallSpec
| DNCall DNCallSpec
deriving( Eq ) -- We compare them when seeing if an interface
-- has changed (for versioning purposes)
newtype ForeignCall = CCall CCallSpec
deriving Eq
{-! derive: Binary !-}
-- We may need more clues to distinguish foreign calls
-- but this simple printer will do for now
instance Outputable ForeignCall where
ppr (CCall cc) = ppr cc
ppr (DNCall dn) = ppr dn
\end{code}
......@@ -69,7 +62,7 @@ data Safety
| PlayRisky -- None of the above can happen; the call will return
-- without interacting with the runtime system at all
deriving( Eq, Show )
deriving ( Eq, Show )
-- Show used just for Show Lex.Token, I think
{-! derive: Binary !-}
......@@ -198,68 +191,6 @@ instance Outputable CCallSpec where
\end{code}
%************************************************************************
%* *
\subsubsection{.NET interop}
%* *
%************************************************************************
\begin{code}
data DNCallSpec =
DNCallSpec Bool -- True => static method/field
DNKind -- what type of access
String -- assembly
String -- fully qualified method/field name.
[DNType] -- argument types.
DNType -- result type.
deriving ( Eq )
{-! derive: Binary !-}
data DNKind
= DNMethod
| DNField
| DNConstructor
deriving ( Eq )
{-! derive: Binary !-}
data DNType
= DNByte
| DNBool
| DNChar
| DNDouble
| DNFloat
| DNInt
| DNInt8
| DNInt16
| DNInt32
| DNInt64
| DNWord8
| DNWord16
| DNWord32
| DNWord64
| DNPtr
| DNUnit
| DNObject
| DNString
deriving ( Eq )
{-! derive: Binary !-}
withDNTypes :: DNCallSpec -> [DNType] -> DNType -> DNCallSpec
withDNTypes (DNCallSpec isStatic k assem nm _ _) argTys resTy
= DNCallSpec isStatic k assem nm argTys resTy
instance Outputable DNCallSpec where
ppr (DNCallSpec isStatic kind ass nm _ _ )
= char '"' <>
(if isStatic then text "static" else empty) <+>
(text (case kind of { DNMethod -> "method" ; DNField -> "field"; DNConstructor -> "ctor" })) <+>
(if null ass then char ' ' else char '[' <> text ass <> char ']') <>
text nm <>
char '"'
\end{code}
%************************************************************************
%* *
\subsubsection{Misc}
......@@ -269,19 +200,8 @@ instance Outputable DNCallSpec where
\begin{code}
{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
instance Binary ForeignCall where
put_ bh (CCall aa) = do
putByte bh 0
put_ bh aa
put_ bh (DNCall ab) = do
putByte bh 1
put_ bh ab
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
return (CCall aa)
_ -> do ab <- get bh
return (DNCall ab)
put_ bh (CCall aa) = put_ bh aa
get bh = do aa <- get bh; return (CCall aa)
instance Binary Safety where
put_ bh (PlaySafe aa) = do
......@@ -342,94 +262,4 @@ instance Binary CCallConv where
0 -> do return CCallConv
1 -> do return StdCallConv
_ -> do return PrimCallConv
instance Binary DNCallSpec where
put_ bh (DNCallSpec isStatic kind ass nm _ _) = do
put_ bh isStatic
put_ bh kind
put_ bh ass
put_ bh nm
get bh = do
isStatic <- get bh
kind <- get bh
ass <- get bh
nm <- get bh
return (DNCallSpec isStatic kind ass nm [] undefined)
instance Binary DNKind where
put_ bh DNMethod = do
putByte bh 0
put_ bh DNField = do
putByte bh 1
put_ bh DNConstructor = do
putByte bh 2
get bh = do
h <- getByte bh
case h of
0 -> do return DNMethod
1 -> do return DNField
_ -> do return DNConstructor
instance Binary DNType where
put_ bh DNByte = do
putByte bh 0
put_ bh DNBool = do
putByte bh 1
put_ bh DNChar = do
putByte bh 2
put_ bh DNDouble = do
putByte bh 3
put_ bh DNFloat = do
putByte bh 4
put_ bh DNInt = do
putByte bh 5
put_ bh DNInt8 = do
putByte bh 6
put_ bh DNInt16 = do
putByte bh 7
put_ bh DNInt32 = do
putByte bh 8
put_ bh DNInt64 = do
putByte bh 9
put_ bh DNWord8 = do
putByte bh 10
put_ bh DNWord16 = do
putByte bh 11
put_ bh DNWord32 = do
putByte bh 12
put_ bh DNWord64 = do
putByte bh 13
put_ bh DNPtr = do
putByte bh 14
put_ bh DNUnit = do
putByte bh 15
put_ bh DNObject = do
putByte bh 16
put_ bh DNString = do
putByte bh 17
get bh = do
h <- getByte bh
case h of
0 -> return DNByte
1 -> return DNBool
2 -> return DNChar
3 -> return DNDouble
4 -> return DNFloat
5 -> return DNInt
6 -> return DNInt8
7 -> return DNInt16
8 -> return DNInt32
9 -> return DNInt64
10 -> return DNWord8
11 -> return DNWord16
12 -> return DNWord32
13 -> return DNWord64
14 -> return DNPtr
15 -> return DNUnit
16 -> return DNObject
17 -> return DNString
-- Imported from other files :-
\end{code}
......@@ -634,9 +634,9 @@ However, we can also do some scoping checks at the same time.
\begin{code}
rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
= lookupLocatedTopBndrRn name `thenM` \ name' ->
return (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
return (ForeignType {tcdLName = name', tcdExtName = ext_name},
emptyFVs)
-- all flavours of type family declarations ("type family", "newtype fanily",
......
......@@ -91,21 +91,6 @@ tcFImport d = pprPanic "tcFImport" (ppr d)
------------ Checking types for foreign import ----------------------
\begin{code}
tcCheckFIType :: Type -> [Type] -> Type -> ForeignImport -> TcM ForeignImport
tcCheckFIType _ arg_tys res_ty (DNImport spec) = do
checkCg checkDotnet
dflags <- getDOpts
checkForeignArgs (isFFIDotnetTy dflags) arg_tys
checkForeignRes nonIOok (isFFIDotnetTy dflags) res_ty
let (DNCallSpec isStatic kind _ _ _ _) = spec
case kind of
DNMethod | not isStatic ->
case arg_tys of
[] -> addErrTc illegalDNMethodSig
_
| not (isFFIDotnetObjTy (last arg_tys)) -> addErrTc illegalDNMethodSig
| otherwise -> return ()
_ -> return ()
return (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ safety _ (CLabel _))
= ASSERT( null arg_tys )
......@@ -268,7 +253,6 @@ tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
-- the structure of the foreign type.
(_, t_ty) = tcSplitForAllTys sig_ty
(arg_tys, res_ty) = tcSplitFunTys t_ty
tcCheckFEType _ d = pprPanic "tcCheckFEType" (ppr d)
\end{code}
......@@ -309,14 +293,6 @@ checkForeignRes non_io_result_ok pred_res_ty ty
\end{code}
\begin{code}
checkDotnet :: HscTarget -> Maybe SDoc
#if defined(mingw32_TARGET_OS)
checkDotnet HscC = Nothing
checkDotnet _ = Just (text "requires C code generation (-fvia-C)")
#else
checkDotnet _ = Just (text "requires .NET support (-filx or win32)")
#endif
checkCOrAsm :: HscTarget -> Maybe SDoc
checkCOrAsm HscC = Nothing
checkCOrAsm HscAsm = Nothing
......@@ -397,10 +373,5 @@ foreignDeclCtxt :: ForeignDecl Name -> SDoc
foreignDeclCtxt fo
= hang (ptext (sLit "When checking declaration:"))
4 (ppr fo)
illegalDNMethodSig :: SDoc
illegalDNMethodSig
= ptext (sLit "'This pointer' expected as last argument")
\end{code}
......@@ -92,7 +92,6 @@ module TcType (
isFFITy, -- :: Type -> Bool
isFunPtrTy, -- :: Type -> Bool
tcSplitIOType_maybe, -- :: Type -> Maybe Type
toDNType, -- :: Type -> DNType
--------------------------------
-- Rexported from Type
......@@ -1258,39 +1257,6 @@ isFFIDotnetObjTy ty
isFunPtrTy :: Type -> Bool
isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
toDNType :: Type -> DNType
toDNType ty
| isStringTy ty = DNString
| isFFIDotnetObjTy ty = DNObject
| Just (tc,argTys) <- tcSplitTyConApp_maybe ty
= case lookup (getUnique tc) dn_assoc of
Just x -> x
Nothing
| tc `hasKey` ioTyConKey -> toDNType (head argTys)
| otherwise -> pprPanic ("toDNType: unsupported .NET type")
(pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
| otherwise = panic "toDNType" -- Is this right?
where
dn_assoc :: [ (Unique, DNType) ]
dn_assoc = [ (unitTyConKey, DNUnit)
, (intTyConKey, DNInt)
, (int8TyConKey, DNInt8)
, (int16TyConKey, DNInt16)
, (int32TyConKey, DNInt32)
, (int64TyConKey, DNInt64)
, (wordTyConKey, DNInt)
, (word8TyConKey, DNWord8)
, (word16TyConKey, DNWord16)
, (word32TyConKey, DNWord32)
, (word64TyConKey, DNWord64)
, (floatTyConKey, DNFloat)
, (doubleTyConKey, DNDouble)
, (ptrTyConKey, DNPtr)
, (funPtrTyConKey, DNPtr)
, (charTyConKey, DNChar)
, (boolTyConKey, DNBool)
]
checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-- Look through newtypes, but *not* foralls
-- Should work even for recursive newtypes
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment