X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsForeign.lhs;h=4d0a148e1598f2ba80de82a371f92275b3be457e;hb=8612b81134c052247ed15b1243b6e8646c20b759;hp=51f03c2f8f2c883153f46dbc4813bc9d5a2a97aa;hpb=3891512c4c770dadd0372ad84d2dec72b34652d2;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 51f03c2..4d0a148 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -43,7 +43,7 @@ import Outputable import FastString import Config import Constants - +import OrdList import Data.Maybe import Data.List \end{code} @@ -66,9 +66,9 @@ type Binding = (Id, CoreExpr) -- No rec/nonrec structure; -- the occurrence analyser will sort it all out dsForeigns :: [LForeignDecl Id] - -> DsM (ForeignStubs, [Binding]) + -> DsM (ForeignStubs, OrdList Binding) dsForeigns [] - = return (NoStubs, []) + = return (NoStubs, nilOL) dsForeigns fos = do fives <- mapM do_ldecl fos let @@ -79,7 +79,7 @@ dsForeigns fos = do return (ForeignStubs (vcat hs) (vcat cs $$ vcat fe_init_code), - (concat bindss)) + foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -207,7 +207,7 @@ dsFCall fn_id fcall = do work_app = mkApps (mkVarApps (Var work_id) tvs) val_args wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers wrap_rhs = mkLams (tvs ++ args) wrapper_body - fn_id_w_inl = fn_id `setIdUnfolding` mkInlineRule wrap_rhs (Just (length args)) + fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs)], empty, empty) \end{code}