diff --git a/src/back/CCode/Main.hs b/src/back/CCode/Main.hs index 73073b6d3..e288fa5b9 100644 --- a/src/back/CCode/Main.hs +++ b/src/back/CCode/Main.hs @@ -99,3 +99,4 @@ data CCode a where String :: String -> CCode Expr Double :: Double -> CCode Expr Comm :: String -> CCode a + Annotated :: String -> CCode a -> CCode a diff --git a/src/back/CCode/PrettyCCode.hs b/src/back/CCode/PrettyCCode.hs index 06af5447b..a33133e1e 100644 --- a/src/back/CCode/PrettyCCode.hs +++ b/src/back/CCode/PrettyCCode.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs,FlexibleContexts #-} +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-| Converting CCode (see "CCode.Main") to C source. @@ -109,6 +110,8 @@ pp' (Int n) = tshow n pp' (String s) = tshow s pp' (Double d) = tshow d pp' (Comm s) = text ("/* "++s++" */") +--Annotated :: CCode a -> String -> CCode a +pp' (Annotated s ccode) = pp' ccode <+> pp' (Comm s) commaList :: [CCode a] -> Doc commaList l = hcat $ intersperse (text ", ") $ map pp' l diff --git a/src/back/CodeGen/ClassDecl.hs b/src/back/CodeGen/ClassDecl.hs index ca2828e36..a9b66e0c1 100644 --- a/src/back/CodeGen/ClassDecl.hs +++ b/src/back/CodeGen/ClassDecl.hs @@ -160,9 +160,10 @@ translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) = -- explode _enc__Foo_bar_msg_t struct into variable names method_unpack_arguments :: A.MethodDecl -> CCode Ty -> [CCode Stat] method_unpack_arguments mdecl msg_type_name = - map unpack (A.mparams mdecl) + zipWith unpack (A.mparams mdecl) [1..] where - unpack A.Param{A.pname, A.ptype} = (Assign (Decl (translate ptype, (Var $ show pname))) ((Cast (msg_type_name) (Var "_m")) `Arrow` (Nam $ show pname))) + unpack :: A.ParamDecl -> Int -> CCode Stat + unpack A.Param{A.pname, A.ptype} n = (Assign (Decl (translate ptype, (Var $ show pname))) ((Cast (msg_type_name) (Var "_m")) `Arrow` (Nam $ "f"++show n))) mthd_dispatch_clause mdecl@(A.Method{A.mname, A.mparams, A.mtype}) = (method_msg_name cname mname, diff --git a/src/back/CodeGen/Header.hs b/src/back/CodeGen/Header.hs index cd56a0555..3fa319a78 100644 --- a/src/back/CodeGen/Header.hs +++ b/src/back/CodeGen/Header.hs @@ -90,8 +90,8 @@ generate_header A.Program{A.etl = A.EmbedTL{A.etlheader}, A.functions, A.classes pony_msg_t_impl :: A.MethodDecl -> CCode Toplevel pony_msg_t_impl mdecl = let argrttys = map (translate . A.getType) (A.mparams mdecl) - argnames = map (Var . show . A.pname) (A.mparams mdecl) - argspecs = zip argrttys argnames :: [CVarSpec] + argnames_w_comments = zipWith (\n name -> (Annotated (show name) (Var ("f"++show n)))) ([1..]:: [Int]) (map A.pname $ A.mparams mdecl) + argspecs = zip argrttys argnames_w_comments :: [CVarSpec] encoremsgtspec = (enc_msg_t, Var "msg") encoremsgtspec_oneway = (enc_oneway_msg_t, Var "msg") nameprefix = "_enc__"++ (show (A.cname cdecl))