remove voidtype!

we no longer need this warty thing to support empty messages in attr get
requests, because we now use sequence numbers instead

hooray

src/Gidl/Backend/Haskell/Types.hs

@@ -61,14 +61,12 @@ typeHaskellType (PrimType  (AtomType a)) = case a of
   AtomWord Bits64 -> "Word64"
   AtomFloat -> "Float"
   AtomDouble -> "Double"
-typeHaskellType (PrimType VoidType) = "()"
 
 typeModuleName :: Type -> String
 typeModuleName (StructType tn _) = userTypeModuleName tn
 typeModuleName (PrimType (Newtype tn _)) = userTypeModuleName tn
 typeModuleName (PrimType (EnumType tn _ _)) = userTypeModuleName tn
 typeModuleName (PrimType (AtomType _)) = error "do not take typeModuleName of an AtomType"
-typeModuleName (PrimType VoidType) = error "do not take typeModuleName of a VoidType"
 
 userTypeModuleName :: String -> String
 userTypeModuleName = first_cap . u_to_camel
@@ -236,7 +234,6 @@ primTypePutter (AtomType (AtomWord Bits32)) = text "putWord32be"
 primTypePutter (AtomType (AtomWord Bits64)) = text "putWord64be"
 primTypePutter (AtomType AtomFloat) = text "putFloat32be"
 primTypePutter (AtomType AtomDouble) = text "putFloat64be"
-primTypePutter VoidType = text "put"
 
 
 typeGetter :: Type -> Doc
@@ -253,7 +250,6 @@ primTypeGetter (AtomType (AtomWord Bits32)) = text "getWord32be"
 primTypeGetter (AtomType (AtomWord Bits64)) = text "getWord64be"
 primTypeGetter (AtomType AtomFloat) = text "getFloat32be"
 primTypeGetter (AtomType AtomDouble) = text "getFloat64be"
-primTypeGetter VoidType = text "get"
 
 sizedPrim :: Bits -> PrimType
 sizedPrim b = AtomType (AtomWord b)
@@ -276,7 +272,6 @@ importType (PrimType (AtomType a)) =
     AtomWord _ -> LibraryType "Data.Word"
     AtomInt _ -> LibraryType "Data.Int"
     _ -> NoImport
-importType (PrimType VoidType) = NoImport
 
 isUserDefined :: Type -> Bool
 isUserDefined tr = case importType tr of

src/Gidl/Backend/Ivory/Schema.hs

@@ -6,7 +6,6 @@ import Data.Monoid
 import Data.List (intercalate, nub)
 import Data.Char (toUpper)
 
-import Gidl.Types hiding (typeName)
 import Gidl.Interface
 import Gidl.Schema
 import Gidl.Backend.Ivory.Types
@@ -61,13 +60,10 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
     , empty
     , text "data" <+> constructor <+> equals <+> constructor
     , indent 2 $ encloseStack lbrace rbrace comma
-        [ case t of
-            PrimType VoidType -> text (accessorName n) <+> colon <> colon
-                <+> text "(forall s r b . Ivory ('Effects r b (Scope s)) IBool)"
-            _ -> text (accessorName n) <+> colon <> colon
-                  <+> parens (text "forall s r b s' . ConstRef s'"
-                    <+> typeIvoryArea t
-                    <+> text "-> Ivory ('Effects r b (Scope s)) IBool")
+        [ text (accessorName n) <+> colon <> colon
+           <+> parens (text "forall s r b s' . ConstRef s'"
+             <+> typeIvoryArea t
+             <+> text "-> Ivory ('Effects r b (Scope s)) IBool")
         | (_, (Message n t)) <- schema
         ]
     , empty
@@ -84,12 +80,10 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
         [ text "unpackWithCallback arr offs $ \\tag_ref -> do"
         , indent 2 $ text "(tag :: Uint32) <- deref tag_ref"
         , indent 2 $ text "cond" <+> encloseStack lbracket rbracket comma
-           [ parens (text "tag ==?" <+> ppr h) <+> text "==>" <+> unpackK
-           | (h, Message n t) <- schema
-           , let k = text (accessorName n) <+> text "iface"
-           , let unpackK = case t of
-                   PrimType VoidType -> k
-                   _ -> text "unpackWithCallback arr offs" <+> parens k
+           [ parens (text "tag ==?" <+> ppr h) <+> text "==>"
+            <+> text "unpackWithCallback arr offs"
+            <+> parens (text (accessorName n) <+> text "iface")
+           | (h, Message n _) <- schema
            ]
         ]
     , empty
@@ -103,35 +97,21 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
     , text (senderName typeName) <+> text "arr offs" <+> equals
         <+> constructor
     , indent 2 $ encloseStack lbrace rbrace comma
-        [ case t of
-            PrimType VoidType -> text (accessorName n) <+> equals <+> text "do" </> indent 4
-                  (stack [ text "o <- deref offs"
-                         , text "let required_size = fromInteger (packSize (packRep :: PackRep (Stored Uint32)))"
-                         , text "    sufficient_space = (o + required_size) <? arrayLen arr"
-                         , text "when sufficient_space $ do"
-                         , indent 2 $ stack
-                             [ text "ident <- local (ival (" <+> ppr h <+> text ":: Uint32))"
-                             , text "packInto arr o (constRef ident)"
-                             , text "offs += required_size"
-                             ]
-                         , text "return sufficient_space"
-                         ])
-
-            _ -> text (accessorName n) <+> equals <+> text "\\m -> do" </> indent 4
-                  (stack [ text "o <- deref offs"
-                         , text "let required_size = fromInteger (packSize (packRep :: PackRep"
-                             <+> typeIvoryArea t <+> text ")"
-                             <+> text "+ packSize (packRep :: PackRep (Stored Uint32)))"
-                         , text "    sufficient_space = (o + required_size) <? arrayLen arr"
-                         , text "when sufficient_space $ do"
-                         , indent 2 $ stack
-                             [ text "ident <- local (ival (" <+> ppr h <+> text ":: Uint32))"
-                             , text "packInto arr o (constRef ident)"
-                             , text "packInto arr (o + fromInteger (packSize (packRep :: PackRep (Stored Uint32)))) m"
-                             , text "offs += required_size"
-                             ]
-                         , text "return sufficient_space"
-                         ])
+        [ text (accessorName n) <+> equals <+> text "\\m -> do" </> indent 4
+            (stack [ text "o <- deref offs"
+                   , text "let required_size = fromInteger (packSize (packRep :: PackRep"
+                       <+> typeIvoryArea t <+> text ")"
+                       <+> text "+ packSize (packRep :: PackRep (Stored Uint32)))"
+                   , text "    sufficient_space = (o + required_size) <? arrayLen arr"
+                   , text "when sufficient_space $ do"
+                   , indent 2 $ stack
+                       [ text "ident <- local (ival (" <+> ppr h <+> text ":: Uint32))"
+                       , text "packInto arr o (constRef ident)"
+                       , text "packInto arr (o + fromInteger (packSize (packRep :: PackRep (Stored Uint32)))) m"
+                       , text "offs += required_size"
+                       ]
+                   , text "return sufficient_space"
+                   ])
         | (h, (Message n t)) <- schema
         ]
     ]

src/Gidl/Backend/Ivory/Types.hs

@@ -76,7 +76,6 @@ typeImportedIvoryType t = typeIvoryType t
 
 typeIvoryArea :: Type -> Doc
 typeIvoryArea t@(StructType _ _) = parens (text (typeIvoryType t))
-typeIvoryArea   (PrimType VoidType) = error "should not take typeIvoryArea of VoidType"
 typeIvoryArea t@(PrimType (AtomType _)) = parens (text "Stored" <+> text (typeIvoryType t))
 typeIvoryArea t@(PrimType _) = parens (text "Stored" <+> text (typeIvoryType t) <> dot <> text (typeIvoryType t))
 
@@ -99,14 +98,12 @@ typeIvoryType (PrimType (AtomType a)) = case a of
   AtomWord Bits64 -> "Uint64"
   AtomFloat -> "IFloat"
   AtomDouble -> "IDouble"
-typeIvoryType (PrimType VoidType) = "()"
 
 typeModuleName :: Type -> String
 typeModuleName (StructType tn _) = userTypeModuleName tn
 typeModuleName (PrimType (Newtype tn _)) = userTypeModuleName tn
 typeModuleName (PrimType (EnumType tn _ _)) = userTypeModuleName tn
 typeModuleName (PrimType (AtomType _)) = error "do not take typeModuleName of an AtomType"
-typeModuleName (PrimType VoidType) = error "do not take typeModuleName of a VoidType"
 
 userTypeModuleName :: String -> String
 userTypeModuleName = first_cap . userEnumValueName
@@ -274,7 +271,6 @@ importType (StructType n _) = UserType n
 importType (PrimType (EnumType n _ _)) = UserType n
 importType (PrimType (Newtype n _)) = UserType n
 importType (PrimType (AtomType _)) = NoImport
-importType (PrimType VoidType) = NoImport
 
 isUserDefined :: Type -> Bool
 isUserDefined t = case importType t of

src/Gidl/Backend/Tower/Schema.hs

@@ -5,7 +5,6 @@ module Gidl.Backend.Tower.Schema where
 import Data.Monoid
 import Data.List (intercalate, nub)
 
-import Gidl.Types hiding (typeName)
 import Gidl.Interface
 import Gidl.Schema
 import Gidl.Backend.Ivory.Types
@@ -64,11 +63,8 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
     , empty
     , text "data" <+> constructor<+> equals <+> constructor
     , indent 2 $ encloseStack lbrace rbrace comma
-        [ case t of
-            PrimType VoidType -> accessorName n <+> colon <> colon
-                <+> text "ChanOutput (Stored IBool)"
-            _ -> accessorName n <+> colon <> colon
-                <+> text "ChanOutput" <+> typeIvoryArea t
+        [ accessorName n <+> colon <> colon
+           <+> text "ChanOutput" <+> typeIvoryArea t
         | (_, (Message n t)) <- schema
         ]
     , empty
@@ -99,15 +95,10 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
                     , text "_ <- I." <> text (parserName typeName)
                         <+> text "f offs $ I." <> constructor
                     , indent 2 $ encloseStack lbrace rbrace comma
-                        [ case t of
-                            PrimType VoidType ->
-                                 text "I." <> accessorName n <+> equals
-                                  <+> text "emitV" <+> emitterName n
-                                  <+> text "true >> return true"
-                            _ -> text "I." <> accessorName n <+> equals
-                                  <+> text "\\v -> emit" <+> emitterName n
-                                  <+> text "v >> return true"
-                        | (_, Message n t) <- schema
+                        [ text "I." <> accessorName n <+> equals
+                            <+> text "\\v -> emit" <+> emitterName n
+                            <+> text "v >> return true"
+                        | (_, Message n _) <- schema
                         ]
                     , text "return ()"
                     ]
@@ -136,9 +127,9 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
         , indent 2 $ stack
             [ text "handler" <+> parens (accessorName n <+> text "a")
                 <+> dquotes (accessorName n) <+> text "$ do"
-                </> indent 2 (parseEmitBody n t)
+                </> indent 2 (parseEmitBody n)
                 </> empty
-            | (_, Message n t) <- schema
+            | (_, Message n _) <- schema
             ]
         , text "return (snd frame_ch)"
         ]
@@ -151,19 +142,7 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
   chanName s = text "ch_" <> text s
   emitterName s = text "emitter_" <> text s
 
-  parseEmitBody n (PrimType VoidType) = stack
-    [ text "e <- emitter (fst frame_ch) 1"
-    , text "callback $ \\_ -> do"
-    , indent 2 $ stack
-        [ text "f <- local izero"
-        , text "o <- local izero"
-        , text "ok <-" <+> text "I." <> accessorName n
-            <+> parens (text "I." <> text (senderName typeName)
-                        <+> text "f o")
-        , text "ifte_ ok (emit e (constRef f)) (return ())"
-        ]
-    ]
-  parseEmitBody n _ = stack
+  parseEmitBody n = stack
     [ text "e <- emitter (fst frame_ch) 1"
     , text "callback $ \\w -> do"
     , indent 2 $ stack

src/Gidl/Types.hs

@@ -29,7 +29,6 @@ typeName :: Type -> TypeName
 typeName (StructType n _) = n
 typeName (PrimType (EnumType n _ _)) = n
 typeName (PrimType (Newtype n _)) = n
-typeName (PrimType VoidType) = error "XXX"
 typeName t@(PrimType (AtomType _)) =
   let TypeEnv bte = baseTypeEnv in
   case lookup t (map swap bte) of
@@ -57,7 +56,6 @@ sizeOf (PrimType (AtomType (AtomInt bs))) = bitsSize bs
 sizeOf (PrimType (AtomType (AtomWord bs))) = bitsSize bs
 sizeOf (PrimType (AtomType AtomFloat)) = 4
 sizeOf (PrimType (AtomType AtomDouble)) = 8
-sizeOf (PrimType VoidType) = 0
 
 bitsSize :: Bits -> Integer
 bitsSize Bits8  = 1

src/Gidl/Types/AST.hs

@@ -19,7 +19,6 @@ data PrimType
   = Newtype  String PrimType
   | EnumType String Bits [(Identifier, Integer)]
   | AtomType Atom
-  | VoidType
   deriving (Eq, Show)
 
 data Atom