Generating proper types for classes

The new Pony RT allows us to unify a lot of code for generating passive/active classes
parapluu · Feb 4, 2015 · ec48ce1 · ec48ce1
1 parent bf45a13
commit ec48ce1
Show file tree

Hide file tree

Showing 5 changed files with 90 additions and 99 deletions.
diff --git a/src/back/CodeGen/CCodeNames.hs b/src/back/CodeGen/CCodeNames.hs
@@ -23,6 +23,7 @@ uint = Typ "uint64_t"
 bool = Typ "int64_t" -- For pony argument tag compatibility. Should be changed to something smaller
 double = Typ "double"
 void = Typ "void"
+encore_actor_t = Typ "encore_actor_t"
 pony_type_t = Typ "pony_type_t"
 pony_actor_t = Typ "pony_actor_t"
 pony_actor_type_t = Typ "pony_actor_type_t"
@@ -46,19 +47,19 @@ global_closure_name funname =
 
 global_function_name :: ID.Name -> CCode Name
 global_function_name funname = 
-    Nam $ "_global_" ++ (show funname) ++ "_fun"
+    Nam $ "_enc__global_" ++ (show funname) ++ "_fun"
 
 closure_fun_name :: String -> CCode Name
 closure_fun_name name =
-    Nam $ "_" ++ name ++ "_fun"
+    Nam $ "_enc__" ++ name ++ "_fun"
 
 closure_env_name :: String -> CCode Name
 closure_env_name name =
-    Nam $ "_" ++ name ++ "_env"
+    Nam $ "_enc__" ++ name ++ "_env"
 
 closure_trace_name :: String -> CCode Name
 closure_trace_name name =
-    Nam $ "_" ++ name ++ "_trace"
+    Nam $ "_enc__" ++ name ++ "_trace"
 
 stream_handle :: CCode Lval
 stream_handle = Var "_stream"
@@ -67,13 +68,13 @@ stream_handle = Var "_stream"
 -- messages to the right method calls. This is the name of that
 -- function.
 class_dispatch_name :: Ty.Type -> CCode Name
-class_dispatch_name clazz = Nam $ Ty.getId clazz ++ "_dispatch"
+class_dispatch_name clazz = Nam $ "_enc__" ++ Ty.getId clazz ++ "_dispatch"
 
 class_message_type_name :: Ty.Type -> CCode Name
 class_message_type_name clazz = Nam $ Ty.getId clazz ++ "_message_type"
 
 class_trace_fn_name :: Ty.Type -> CCode Name
-class_trace_fn_name clazz = Nam $ Ty.getId clazz ++ "_trace"
+class_trace_fn_name clazz = Nam $ "_enc__" ++ Ty.getId clazz ++ "_trace"
 
 method_message_type_name :: Ty.Type -> ID.Name -> CCode Lval --fixme should be a name
 method_message_type_name clazz mname = Var $ "m_"++Ty.getId clazz++"_"++show mname
@@ -92,6 +93,24 @@ one_way_send_msg_name clazz mname = Nam $ "MSG_"++Ty.getId clazz++"__one_way_"++
 data_rec_name :: Ty.Type -> CCode Name
 data_rec_name clazz = Nam $ Ty.getId clazz ++ "_data"
 
+class_type_name :: Ty.Type -> CCode Name
+class_type_name cls 
+    | Ty.isActiveRefType cls =
+        Nam $ "_enc__active_" ++ Ty.getId cls ++ "_t"
+    | Ty.isPassiveRefType cls =
+        Nam $ "_enc__passive_" ++ Ty.getId cls ++ "_t"
+    | otherwise = error $ "Type '" ++ show cls ++ 
+                          "' is neither active nor passive!" 
+
+runtime_type_name :: Ty.Type -> CCode Name
+runtime_type_name cls 
+    | Ty.isActiveRefType cls =
+        Nam $ "_enc__active_" ++ Ty.getId cls ++ "_type"
+    | Ty.isPassiveRefType cls =
+        Nam $ "_enc__passive_" ++ Ty.getId cls ++ "_type"
+    | otherwise = error $ "Type '" ++ show cls ++ 
+                          "' is neither active nor passive!" 
+
 data_rec_type :: Ty.Type -> CCode Ty
 data_rec_type clazz = Typ $ Ty.getId clazz ++ "_data"
 

diff --git a/src/back/CodeGen/ClassDecl.hs b/src/back/CodeGen/ClassDecl.hs
@@ -35,45 +35,21 @@ instance Translatable A.ClassDecl (CCode FIN) where
 translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) =
     Program $ Concat $
       (LocalInclude "header.h") :
-      [data_struct] ++
-      [tracefun_decl] ++
+      [type_struct] ++
+      [tracefun_decl cdecl] ++
       pony_msg_t_impls ++
       [message_type_decl] ++
       method_impls ++
       [dispatchfun_decl] ++
-      [pony_actor_t_impl]
+      [pony_type_t_decl cname]
     where
-      data_struct :: CCode Toplevel
-      data_struct = StructDecl (data_rec_type cname) $
-                     ((Ptr $ pony_actor_t, Var "aref") :
+      type_struct :: CCode Toplevel
+      type_struct = StructDecl (AsType $ class_type_name cname) $
+                     ((encore_actor_t, Var "_enc__actor") :
                          zip
                          (map (translate  . A.ftype) fields)
                          (map (Var . show . A.fname) fields))
 
-      tracefun_decl :: CCode Toplevel
-      tracefun_decl = 
-          case find ((== Ty.getId cname ++ "_trace") . show . A.mname) methods of
-            Just mdecl@(A.Method{A.mbody, A.mname}) ->
-                    Function void (class_trace_fn_name cname) 
-                             [(Ptr void, Var "p")]
-                             (Statement $ Call (method_impl_name cname mname)
-                                          [Var "p"])
-
-            Nothing -> 
-                Function void (class_trace_fn_name cname) 
-                         [(Ptr void, Var "p")]
-                         (Seq $ map trace_field fields)
-          where
-            trace_field A.Field {A.ftype, A.fname}
-                | Ty.isActiveRefType ftype =
-                    Call (Nam "pony_traceactor") [get_field fname]
-                | Ty.isPassiveRefType ftype =
-                    Call (Nam "pony_traceobject") [get_field fname, AsLval $ class_trace_fn_name ftype]
-                | otherwise =
-                    Embed $ "/* Not tracing field '" ++ show fname ++ "' */"
-
-            get_field f = Deref (Cast (data_rec_ptr cname) (Var "p")) `Dot` (Nam $ show f)
-
       pony_msg_t_impls :: [CCode Toplevel]
       pony_msg_t_impls = map pony_msg_t_impl methods
           where
@@ -242,60 +218,58 @@ translateActiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) =
                          other           ->
                              error $ "ClassDecl.hs: paramdecl_to_argv not implemented for "++show ptype)
 
-      pony_actor_t_impl =
-                (AssignTL
-                 (Decl (Typ "pony_actor_type_t", AsLval $ actor_rec_name cname))
-                 (Record [AsExpr . AsLval . Nam $ ("ID_"++(Ty.getId cname)),
-                          pony_type_t_rec,
-                          AsExpr . AsLval $ class_message_type_name cname,
-                          AsExpr . AsLval $ class_dispatch_name cname]))
-          where
-            pony_type_t_rec = 
-                Record [Call (Nam "sizeof") [Var . show $ data_rec_name cname],
-                        AsExpr . AsLval $ (class_trace_fn_name cname),
-                        Null,
-                        Null]
-
 -- | Translates a passive class into its C representation. Note
 -- that there are additional declarations (including the data
 -- struct for instance variables) in the file generated by
 -- "CodeGen.Header"
 translatePassiveClass cdecl@(A.Class{A.cname, A.fields, A.methods}) =
     Program $ Concat $
       (LocalInclude "header.h") :
-      [tracefun_decl] ++
+      [tracefun_decl cdecl] ++
       method_impls ++
-      [pony_type_t_impl]
+      [pony_type_t_decl cname]
 
     where
-      tracefun_decl :: CCode Toplevel
-      tracefun_decl = 
-          case find ((== Ty.getId cname ++ "_trace") . show . A.mname) methods of
-            Just mdecl@(A.Method{A.mbody, A.mname}) ->
-                    Function void (class_trace_fn_name cname) 
-                             [(Ptr void, Var "p")]
-                             (Statement $ Call (method_impl_name cname mname)
-                                          [Var "p"])
-
-            Nothing -> 
-                Function void (class_trace_fn_name cname)
-                   [(Ptr void, Var "p")]
-                   (Seq $ map trace_field fields)
-          where
-            trace_field A.Field {A.ftype, A.fname}
-                | Ty.isActiveRefType ftype = Call (Nam "pony_traceactor") [get_field fname]
-                | Ty.isPassiveRefType ftype = Call (Nam "pony_traceobject") [get_field fname, AsLval $ class_trace_fn_name ftype]
-                | otherwise = Embed $ "/* Not tracing field '" ++ show fname ++ "' */"
-                where
-                  get_field f = Deref (Cast (data_rec_ptr cname) (Var "p")) `Dot` (Nam $ show f)
-
       method_impls = map method_decl methods
           where
             method_decl mdecl = translate mdecl cdecl
 
-      pony_type_t_impl = 
-          (AssignTL (Decl (Typ "pony_type_t", AsLval $ type_rec_name cname))
-                    (Record [Call (Nam "sizeof") [Var . show $ data_rec_name cname],
-                             AsExpr . AsLval $ (class_trace_fn_name cname),
-                             Null,
-                             Null]))
+tracefun_decl :: A.ClassDecl -> CCode Toplevel
+tracefun_decl A.Class{A.cname, A.fields, A.methods} = 
+    case find ((== Ty.getId cname ++ "_trace") . show . A.mname) methods of
+      Just mdecl@(A.Method{A.mbody, A.mname}) ->
+          Function void (class_trace_fn_name cname) 
+                   [(Ptr void, Var "p")]
+                   (Statement $ Call (method_impl_name cname mname)
+                                [Var "p"])
+      Nothing -> 
+          Function void (class_trace_fn_name cname) 
+                   [(Ptr void, Var "p")]
+                   (Seq $ 
+                    (Assign (Decl (Ptr . AsType $ class_type_name cname, Var "this"))
+                            (Var "p")) :
+                     map (Statement . trace_field) fields)
+    where
+      trace_field A.Field {A.ftype, A.fname}
+          | Ty.isActiveRefType ftype =
+              Call (Nam "pony_traceactor") [get_field fname]
+          | Ty.isPassiveRefType ftype =
+              Call (Nam "pony_traceobject") 
+                   [get_field fname, AsLval $ class_trace_fn_name ftype]
+          | otherwise =
+              Embed $ "/* Not tracing field '" ++ show fname ++ "' */"
+
+      get_field f = 
+          (Var "this") `Arrow` (Nam $ show f)
+
+
+pony_type_t_decl cname =
+    (AssignTL
+     (Decl (Typ "pony_type_t", AsLval $ runtime_type_name cname))
+           (Record [AsExpr . AsLval . Nam $ ("ID_"++(Ty.getId cname)),
+                    Call (Nam "sizeof") [AsLval $ class_type_name cname],
+                    AsExpr . AsLval $ (class_trace_fn_name cname),
+                    Null,
+                    Null,           
+                    AsExpr . AsLval $ class_dispatch_name cname,
+                    Null]))
diff --git a/src/back/CodeGen/Header.hs b/src/back/CodeGen/Header.hs
@@ -58,11 +58,11 @@ generate_header A.Program{A.etl = A.EmbedTL{A.etlheader}, A.functions, A.classes
        [comment_section "Trace functions"] ++
        trace_fn_decls ++
 
-       [comment_section "Data structs"] ++
-       data_struct_decls ++ 
+       [comment_section "Class types"] ++
+       class_type_decls ++ 
 
-       [comment_section "Passive class data structs"] ++
-       passive_data_structs ++ 
+       [comment_section "Passive class types"] ++
+       passive_types ++ 
 
        [comment_section "Actor types"] ++
        actor_decls ++
@@ -103,22 +103,22 @@ generate_header A.Program{A.etl = A.EmbedTL{A.etlheader}, A.functions, A.classes
         let
           names = map (("ID_"++) . Ty.getId . A.cname) classes
         in
-         Enum $ map Nam names
+         Enum $ (Nam "__DUMMY__ = 1024") : map Nam names
 
       trace_fn_decls = map trace_fn_decl classes
           where
             trace_fn_decl A.Class{A.cname} =
                       FunctionDecl void (class_trace_fn_name cname) [Ptr void]
 
-      data_struct_decls = map data_struct_decl classes
+      class_type_decls = map class_type_decl classes
           where
-            data_struct_decl A.Class{A.cname} = 
-                Typedef (Struct $ data_rec_name cname) (data_rec_name cname)
+            class_type_decl A.Class{A.cname} = 
+                Typedef (Struct $ class_type_name cname) (class_type_name cname)
 
-      passive_data_structs = map passive_data_struct $ filter (not . A.isActive) classes
+      passive_types = map passive_type $ filter (not . A.isActive) classes
           where
-            passive_data_struct A.Class{A.cname, A.fields} = 
-                StructDecl (data_rec_type cname) 
+            passive_type A.Class{A.cname, A.fields} = 
+                StructDecl (AsType $ class_type_name cname) 
                            (zip
                             (map (translate . A.ftype) fields)
                             (map (Var . show . A.fname) fields))
@@ -135,12 +135,12 @@ generate_header A.Program{A.etl = A.EmbedTL{A.etlheader}, A.functions, A.classes
           where
             method_fwd A.Method{A.mtype, A.mname, A.mparams} =
               let params = if (A.isMainClass cdecl) && (mname == ID.Name "main")
-                           then [data_rec_ptr cname, int, Ptr $ Ptr char]
-                           else data_rec_ptr cname : map (\(A.Param {A.ptype}) -> (translate ptype)) mparams
+                           then [Ptr . AsType $ class_type_name cname, int, Ptr $ Ptr char]
+                           else (Ptr . AsType $ class_type_name cname) : map (\(A.Param {A.ptype}) -> (translate ptype)) mparams
               in
                 FunctionDecl (translate mtype) (method_impl_name cname mname) params
             method_fwd A.StreamMethod{A.mtype, A.mname, A.mparams} =
-              let params = data_rec_ptr cname : stream : map (\(A.Param {A.ptype}) -> (translate ptype)) mparams
+              let params = (Ptr . AsType $ class_type_name cname) : stream : map (\(A.Param {A.ptype}) -> (translate ptype)) mparams
               in
                 FunctionDecl void (method_impl_name cname mname) params
 

diff --git a/src/back/CodeGen/MethodDecl.hs b/src/back/CodeGen/MethodDecl.hs
@@ -34,8 +34,8 @@ instance Translatable A.MethodDecl (A.ClassDecl -> CCode Toplevel) where
        [Function (translate mtype) (method_impl_name cname mname)
         -- When we have a top-level main function, this should be cleaned up
            (if (A.isMainClass cdecl) && (A.mname mdecl == ID.Name "main")
-            then [(data_rec_ptr cname, Var "this"), (int, Var "argc"), (Ptr $ Ptr char, Var "argv")]
-            else (data_rec_ptr cname, Var "this") : (map mparam_to_cvardecl mparams))
+            then [(Ptr . AsType $ class_type_name cname, Var "this"), (int, Var "argc"), (Ptr $ Ptr char, Var "argv")]
+            else (Ptr . AsType $ class_type_name cname, Var "this") : (map mparam_to_cvardecl mparams))
            (if not $ Ty.isVoidType mtype
             then (Seq $ bodys : [Return bodyn])
             else (Seq $ bodys : [Return unit]))]
@@ -50,7 +50,7 @@ instance Translatable A.MethodDecl (A.ClassDecl -> CCode Toplevel) where
     in
       Concat $ closures ++ 
        [Function void (method_impl_name cname mname)
-           ((data_rec_ptr cname, Var "this") : (stream, stream_handle) : 
+           ((Ptr . AsType $ class_type_name cname, Var "this") : (stream, stream_handle) : 
             (map mparam_to_cvardecl mparams))
            (Seq $ bodys : [Statement $ Call (Nam "stream_close") [stream_handle]])]
     where

diff --git a/src/back/CodeGen/Type.hs b/src/back/CodeGen/Type.hs
@@ -28,9 +28,7 @@ translatePrimitive ty
 instance Translatable Ty.Type (CCode Ty) where
     translate ty
         | Ty.isPrimitive ty      = translatePrimitive ty
-        | Ty.isActiveRefType ty  = Ptr pony_actor_t 
-        | Ty.isPassiveRefType ty = Ptr $ Typ (show (data_rec_name ty))
-        | Ty.isRefType ty        = error $ "Unknown activity of class '" ++ show ty ++ "'"
+        | Ty.isRefType ty        = Ptr . AsType $ class_type_name ty
         | Ty.isArrowType ty      = closure
         | Ty.isTypeVar ty        = Ptr void
         | Ty.isFutureType ty     = future