-- implicit in the data type declaration itself
mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons,
cg_binds = binds})
- -- Note that we flatten binds at the top level:
- -- every module is just a single recursive bag of declarations.
- -- Rationale: since modules can be mutually recursive,
- -- there's not much reason to preserve dependency info within a module.
- = C.Module mname tdefs (case flattenBinds binds of
- -- check for empty list so we don't create an
- -- empty Rec group
- [] -> []
- bs -> [(runCoreM (make_vdef True
- (Rec bs)) this_mod)])
+{- Note that modules can be mutually recursive, but even so, we
+ print out dependency information within each module. -}
+ = C.Module mname tdefs (runCoreM (mapM (make_vdef True) binds) this_mod)
where
mname = make_mid this_mod
tdefs = foldr collect_tdefs [] tycons
Nothing -> pprPanic ("MkExternalCore: newtype tcon\
should have a coercion: ") (ppr tcon))
(map make_tbind tyvars)
- repclause
+ (make_ty (snd (newTyConRhs tcon)))
| otherwise =
C.Data (qtc tcon) (map make_tbind tyvars)
(map make_cdef (tyConDataCons tcon))
- where repclause | isRecursiveTyCon tcon || isOpenTyCon tcon= Nothing
- | otherwise = Just (make_ty (snd (newTyConRhs tcon)))
tyvars = tyConTyVars tcon
collect_tdefs _ tdefs = tdefs
make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv))
make_vbind :: Var -> C.Vbind
-make_vbind v = (make_var_id (Var.varName v), make_ty (idType v))
+make_vbind v = (make_var_id (Var.varName v), make_ty (varType v))
make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg
make_vdef topLevel b =
let local = not topLevel || localN
rhs <- make_exp e
-- use local flag to determine where to add the module name
- return (local, make_qid local True vName, make_ty (idType v),rhs)
+ return (local, make_qid local True vName, make_ty (varType v),rhs)
where vName = Var.varName v
make_exp :: CoreExpr -> CoreM C.Exp
let vName = Var.varName v
isLocal <- isALocal vName
return $
- case globalIdDetails v of
+ case idDetails v of
FCallId (CCall (CCallSpec (StaticTarget nm) callconv _))
- -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v))
+ -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (varType v))
FCallId (CCall (CCallSpec DynamicTarget callconv _))
- -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (idType v))
+ -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (varType v))
FCallId _
-> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call"
(ppr v)
DataConWorkId _ -> C.Var (make_var_qid False vName)
DataConWrapId _ -> C.Var (make_var_qid False vName)
_ -> C.Var (make_var_qid isLocal vName)
-make_exp (Lit (MachLabel s _)) = return $ C.Label (unpackFS s)
+make_exp (Lit (MachLabel s _ _)) = return $ C.Label (unpackFS s)
make_exp (Lit l) = return $ C.Lit (make_lit l)
make_exp (App e (Type t)) = make_exp e >>= (\ b -> return $ C.Appt b (make_ty t))
make_exp (App e1 e2) = do