import ForeignCall
import DynFlags
import FastString
+import Exception
import Data.Char
import System.IO
emitExternalCore dflags cg_guts
| dopt Opt_EmitExternalCore dflags
= (do handle <- openFile corename WriteMode
- hPutStrLn handle (show (mkExternalCore cg_guts))
+ hPutStrLn handle (show (mkExternalCore cg_guts))
hClose handle)
- `catch` (\_ -> pprPanic "Failed to open or write external core output file"
- (text corename))
+ `catchIO` (\_ -> pprPanic "Failed to open or write external core output file"
+ (text corename))
where corename = extCoreName dflags
emitExternalCore _ _
| otherwise
isLocal <- isALocal vName
return $
case idDetails v of
- FCallId (CCall (CCallSpec (StaticTarget nm) callconv _))
+ FCallId (CCall (CCallSpec (StaticTarget nm _) callconv _))
-> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (varType v))
FCallId (CCall (CCallSpec DynamicTarget callconv _))
-> C.DynExternal (showSDoc (ppr callconv)) (make_ty (varType v))
rator <- make_exp e1
rand <- make_exp e2
return $ C.App rator rand
-make_exp (Lam v e) | isTyVar v = make_exp e >>= (\ b ->
+make_exp (Lam v e) | isTyCoVar v = make_exp e >>= (\ b ->
return $ C.Lam (C.Tb (make_tbind v)) b)
make_exp (Lam v e) | otherwise = make_exp e >>= (\ b ->
return $ C.Lam (C.Vb (make_vbind v)) b)
return $ C.Case scrut (make_vbind v) (make_ty ty) newAlts
make_exp (Note (SCC _) e) = make_exp e >>= (return . C.Note "SCC") -- temporary
make_exp (Note (CoreNote s) e) = make_exp e >>= (return . C.Note s) -- hdaume: core annotations
-make_exp (Note InlineMe e) = make_exp e >>= (return . C.Note "InlineMe")
make_exp _ = error "MkExternalCore died: make_exp"
make_alt :: CoreAlt -> CoreM C.Alt
(map make_tbind tbs)
(map make_vbind vbs)
newE
- where (tbs,vbs) = span isTyVar vs
+ where (tbs,vbs) = span isTyCoVar vs
make_alt (LitAlt l,_,e) = make_exp e >>= (return . (C.Alit (make_lit l)))
make_alt (DEFAULT,[],e) = make_exp e >>= (return . C.Adefault)
-- This should never happen, as the DEFAULT alternative binds no variables,