X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkExternalCore.lhs;h=150ae16b1864b3971851f71f2aad20f92f76af72;hb=b88025eabcd83f65d1d81f09272f5172f06a60e7;hp=246bfa05c74768b963286fc7166798b27c82b985;hpb=27897431cf24d4bde04b15947440c7205f2d703c;p=ghc-hetmet.git diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 246bfa0..150ae16 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,18 @@ import TyCon import TypeRep import Type import PprExternalCore -- Instances -import DataCon ( DataCon, dataConExTyVars, dataConRepArgTys, - dataConName, dataConTyCon ) +import DataCon import CoreSyn 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 +105,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)