Merge pull request #71 from kaeluka/new-ponyrt

Generate structs for messages conforming to the new PonyRT
parapluu · Feb 4, 2015 · f41b8a8 · f41b8a8
2 parents ec48ce1 + bf853ae
commit f41b8a8
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 19 deletions.
diff --git a/src/back/CCode/Main.hs b/src/back/CCode/Main.hs
@@ -72,7 +72,7 @@ data CCode a where
     Deref        :: UsableAs e Expr => CCode e -> CCode Expr
     Cast         :: UsableAs e Expr => CCode Ty -> CCode e -> CCode Expr
     ArrAcc       :: Int -> CCode Lval -> CCode Lval
-    Amp          :: (UsableAs e Expr) => CCode e -> CCode Expr
+    Amp          :: (UsableAs e Expr) => CCode e -> CCode Expr -- | Ampersand
     Ptr          :: CCode Ty -> CCode Ty
     FunctionDecl :: CCode Ty -> CCode Name -> [CCode Ty] -> CCode Toplevel
     Function     :: CCode Ty -> CCode Name -> [CVarSpec] -> CCode Stat -> CCode Toplevel

diff --git a/src/back/CodeGen/CCodeNames.hs b/src/back/CodeGen/CCodeNames.hs
@@ -29,6 +29,8 @@ pony_actor_t = Typ "pony_actor_t"
 pony_actor_type_t = Typ "pony_actor_type_t"
 pony_arg_t = Typ "pony_arg_t"
 pony_msg_t = Typ "pony_msg_t"
+enc_msg_t = Typ "encore_fut_msg_t"
+enc_oneway_msg_t = Typ "encore_oneway_msg_t"
 closure = Ptr $ Typ "closure_t"
 future = Ptr $ Typ "future_t"
 stream = Ptr $ Typ "stream_t"
@@ -127,4 +129,4 @@ future_type_rec_name :: CCode Name
 future_type_rec_name = Nam $ "future_type"
 
 closure_type_rec_name :: CCode Name
-closure_type_rec_name = Nam $ "closure_type"
+closure_type_rec_name = Nam $ "closure_type"
diff --git a/src/back/CodeGen/ClassDecl.hs b/src/back/CodeGen/ClassDecl.hs
@@ -53,24 +53,17 @@ translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) =
       pony_msg_t_impls :: [CCode Toplevel]
       pony_msg_t_impls = map pony_msg_t_impl methods
           where
+            pony_msg_t_impl :: A.MethodDecl -> CCode Toplevel
             pony_msg_t_impl mdecl =
-                Concat
-                  [AssignTL
-                     (Decl (Static (Typ "pony_msg_t"),
-                           (method_message_type_name cname (A.mname mdecl))))
-                     (if (A.isMainClass cdecl) && (A.mname mdecl == ID.Name "main") then
-                          (Record 
-                           [Int $ length (A.mparams mdecl), 
-                            Record $ map (runtime_type . A.getType) (A.mparams mdecl)])
-                      else
-                          (Record
-                           [Int $ length (A.mparams mdecl) + 1, -- plus 1 for future argument
-                            Record $ Amp future_type_rec_name : map (runtime_type . A.getType) (A.mparams mdecl)])), 
-                   AssignTL 
-                     (Decl (Static (Typ "pony_msg_t"), 
-                            one_way_message_type_name cname (A.mname mdecl)))
-                     (Record [Int $ length (A.mparams mdecl), 
-                              Record $ map (runtime_type . A.getType) (A.mparams mdecl)])]
+              let argrttys = map (translate . A.getType) (A.mparams mdecl)
+                  argnames = map (Var . show . A.pname)  (A.mparams mdecl)
+                  argspecs = zip argrttys argnames :: [CVarSpec]
+                  encoremsgtspec = (enc_msg_t, Var "msg")
+                  encoremsgtspec_oneway = (enc_oneway_msg_t, Var "msg")
+                  nameprefix = "encore_"++ (show (A.cname cdecl))
+                                ++ "_" ++ (show (A.mname mdecl))
+              in Concat [StructDecl (Typ $ nameprefix ++ "_fut_msg") (encoremsgtspec : argspecs)
+                        ,StructDecl (Typ $ nameprefix ++ "_oneway_msg") (encoremsgtspec_oneway : argspecs)]
 
       message_type_decl :: CCode Toplevel
       message_type_decl =