X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkExternalCore.lhs;h=150ae16b1864b3971851f71f2aad20f92f76af72;hb=8100cd4395e46ae747be4298c181a4730d6206bc;hp=e7d79e616270742fb5cec8881557b1defd3bf39a;hpb=0b86bc9b022a5965d2b35f143ff4b919f784e676;p=ghc-hetmet.git diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index e7d79e6..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 @@ -69,7 +68,7 @@ collect_tdefs tcon tdefs -- | null (tyConDataCons tcon) = error "MkExternalCore died: can't handle datatype declarations with no data constructors" | otherwise = C.Data (make_con_qid (tyConName tcon)) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) - where repclause | isRecursiveTyCon tcon = Nothing + where repclause | isRecursiveTyCon tcon || isOpenTyCon tcon= Nothing | otherwise = Just (make_ty rep) where (_, rep) = newTyConRep tcon tyvars = tyConTyVars tcon @@ -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)