X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkExternalCore.lhs;h=de907cf214347c63d712fb3bbd9e0f54b4bbf4d8;hp=246bfa05c74768b963286fc7166798b27c82b985;hb=de777ba42eb12b6a20e548a959b23b60179d9b57;hpb=27897431cf24d4bde04b15947440c7205f2d703c diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 246bfa0..de907cf 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -1,5 +1,5 @@ -% (c) The University of Glasgow 2001 +% (c) The University of Glasgow 2001-2006 % \begin{code} @@ -18,19 +18,19 @@ import TyCon import TypeRep import Type import PprExternalCore -- Instances -import DataCon ( DataCon, dataConExTyVars, dataConRepArgTys, - dataConName, dataConTyCon ) +import DataCon import CoreSyn +import Coercion import Var import IdInfo import Literal import Name -import NameSet ( NameSet, emptyNameSet ) -import UniqSet ( elementOfUniqSet ) +import NameSet +import UniqSet import Outputable import ForeignCall -import DynFlags ( DynFlags(..) ) -import StaticFlags ( opt_EmitExternalCore ) +import DynFlags +import StaticFlags import IO import FastString @@ -106,10 +106,15 @@ make_exp (Var v) = case globalIdDetails v of -- a DataConId represents the Id of a worker, which is a varName. -- sof 4/02 -- DataConId _ -> C.Dcon (make_con_qid (Var.varName v)) - FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.External (unpackFS nm) (make_ty (idType v)) - FCallId _ -> error "MkExternalCore died: can't handle non-static-C foreign call" + FCallId (CCall (CCallSpec (StaticTarget nm) callconv _)) + -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v)) + FCallId (CCall (CCallSpec DynamicTarget callconv _)) + -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (idType v)) + FCallId _ + -> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call" + (ppr v) _ -> C.Var (make_var_qid (Var.varName v)) -make_exp (Lit (l@(MachLabel s _))) = error "MkExternalCore died: can't handle \"foreign label\" declarations" +make_exp (Lit (l@(MachLabel s _))) = C.Label (unpackFS s) make_exp (Lit l) = C.Lit (make_lit l) make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t) make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2) @@ -175,7 +180,8 @@ make_ty (NoteTy _ t) = make_ty t make_kind :: Kind -> C.Kind -make_kind (PredTy p) | isEqPred p = panic "coercion kinds in external core not implemented!" +make_kind (PredTy p) | isEqPred p = C.Keq (make_ty t1) (make_ty t2) + where (t1, t2) = getEqPredTys p make_kind (FunTy k1 k2) = C.Karrow (make_kind k1) (make_kind k2) make_kind k | isLiftedTypeKind k = C.Klifted