Allow Unit to be used as a member type in deftypes

This commit enables support for using values of type () (Unit) in
user-defined types such as product and sumtypes. After this commit,
types such as:

    (deftype Units [action-one () action-two ()])

Are valid, and can be instantiated in the obvious way:

    (Units.init (IO.println "foo") ())

Some important things to note about the implementation:

- The C structs emitted for types containing Unit members *completely
  omit all unit members*. If a type in Carp has N members, the
  corresponding C struct will have (N-U) members where U is the number of
  members with the type `Unit`.

  For example, this type:

    (deftype (Foo [one Unit two Int]))

  will produce the following typedef in C:

    typedef struct {
      int two;
    } Foo;

  As a special case, types that *only* have Unit's as members are represented and
  initialized as completely empty structs:

    (deftype Foo [empty Unit])

    // emits

    typedef struct {
    } Foo;

    Foo Foo_init() {
      Foo instance = {};

      return instance;
    }

   Such a type is merely a container for side effects.

- Side effects are not stored at all in the types that contain Unit
  members. Instead, any side effects will be lifted out of the emitted C
  struct and called prior to initialization.

  For example, initializing `(deftype Foo [empty Unit])` with `(Foo.init
  (IO.println "foo"))` will produce the following C:

    main(...) {
      //...
      static String _10 = "foo";
      String *_10_ref = &_10;
      IO_println(_10_ref);
      Foo _12 = Foo_init();
      //...
    }

- The typical operations on product fields are supported on Unit type
  members, but they have slightly custom semantics. Since we don't
  actually store any values of type Unit in custom types, most
  updaters/getters/setters simply run a side effect.

  This is mostly only supported to make the use of such members more
  intuitive and allow programmers to chain side-effects within some
  context, much like monadic IO in Haskell.

- Match forms also work on Unit types for parity, but again, there is no
  meaningful behavior here, since Unit only has a single type
  inhabitant.

As a bonus, this commit also makes it possible to use `Unit` and `()`
interchangeably in type signatures.

src/Deftype.hs

@@ -77,23 +77,45 @@ templatesForMembers _ _ _ _ _ = error "Shouldn't reach this case (invalid type d
 -- | Generate the templates for a single member in a deftype declaration.
 templatesForSingleMember :: TypeEnv -> Env -> [String] -> Ty -> (XObj, XObj) -> [((String, Binder), [XObj])]
 templatesForSingleMember typeEnv env insidePath p@(StructTy (ConcreteNameTy typeName) _) (nameXObj, typeXObj) =
-  let Just t = xobjToTy typeXObj
-      memberName = getName nameXObj
-  in [instanceBinderWithDeps (SymPath insidePath memberName) (FuncTy [RefTy p (VarTy "q")] (RefTy t (VarTy "q")) StaticLifetimeTy) (templateGetter (mangle memberName) t) ("gets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "`.")
-     , if isTypeGeneric t
-       then (templateGenericSetter insidePath p t memberName, [])
-       else instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) (FuncTy [p, t] p StaticLifetimeTy) (templateSetter typeEnv env (mangle memberName) t) ("sets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "`.")
-     , if isTypeGeneric t
-       then (templateGenericMutatingSetter insidePath p t memberName, [])
-       else instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName ++ "!")) (FuncTy [RefTy p (VarTy "q"), t] UnitTy StaticLifetimeTy) (templateMutatingSetter typeEnv env (mangle memberName) t) ("sets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "` in place.")
-     ,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
-                                                            (FuncTy [p, RefTy (FuncTy [t] t (VarTy "fq")) (VarTy "q")] p StaticLifetimeTy)
-                                                            (templateUpdater (mangle memberName))
-                                                            ("updates the `" ++ memberName ++ "` property of a `" ++ typeName ++ "` using a function `f`.")
-                                                            ]
+  case t of
+    -- Unit member types are special since we do not represent them in emitted c.
+    -- Instead, members of type Unit are executed for their side effects and silently omitted
+    -- from the produced C structs.
+    UnitTy ->
+      binders (FuncTy [RefTy p (VarTy "q")] UnitTy StaticLifetimeTy)
+              (FuncTy [p, t] p StaticLifetimeTy)
+              (FuncTy [RefTy p (VarTy "q"), t] UnitTy StaticLifetimeTy)
+              (FuncTy [p, RefTy (FuncTy [] UnitTy (VarTy "fq")) (VarTy "q")] p StaticLifetimeTy)
+    _ ->
+      binders (FuncTy [RefTy p (VarTy "q")] (RefTy t (VarTy "q")) StaticLifetimeTy)
+              (FuncTy [p, t] p StaticLifetimeTy)
+              (FuncTy [RefTy p (VarTy "q"), t] UnitTy StaticLifetimeTy)
+              (FuncTy [p, RefTy (FuncTy [t] t (VarTy "fq")) (VarTy "q")] p StaticLifetimeTy)
+  where  Just t = xobjToTy typeXObj
+         memberName = getName nameXObj
+         binders getterSig setterSig mutatorSig updaterSig =
+          [instanceBinderWithDeps (SymPath insidePath memberName) getterSig (templateGetter (mangle memberName) t) ("gets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "`.")
+          , if isTypeGeneric t
+            then (templateGenericSetter insidePath p t memberName, [])
+            else instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName)) setterSig (templateSetter typeEnv env (mangle memberName) t) ("sets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "`.")
+          , if isTypeGeneric t
+            then (templateGenericMutatingSetter insidePath p t memberName, [])
+            else instanceBinderWithDeps (SymPath insidePath ("set-" ++ memberName ++ "!")) mutatorSig (templateMutatingSetter typeEnv env (mangle memberName) t) ("sets the `" ++ memberName ++ "` property of a `" ++ typeName ++ "` in place.")
+          ,instanceBinderWithDeps (SymPath insidePath ("update-" ++ memberName))
+                                                                 updaterSig
+                                                                 (templateUpdater (mangle memberName) t)
+                                                                 ("updates the `" ++ memberName ++ "` property of a `" ++ typeName ++ "` using a function `f`.")
+                                                                 ]
 
 -- | The template for getters of a deftype.
 templateGetter :: String -> Ty -> Template
+templateGetter member UnitTy =
+  Template
+    (FuncTy [RefTy (VarTy "p") (VarTy "q")] UnitTy StaticLifetimeTy)
+    (const (toTemplate "void $NAME($(Ref p) p)"))
+    -- Execution of the action passed as an argument is handled in Emit.hs.
+    (const $ toTemplate ("$DECL { return; }\n"))
+    (const [])
 templateGetter member memberTy =
   Template
     (FuncTy [RefTy (VarTy "p") (VarTy "q")] (VarTy "t") StaticLifetimeTy)
@@ -108,6 +130,13 @@ templateGetter member memberTy =
 
 -- | The template for setters of a concrete deftype.
 templateSetter :: TypeEnv -> Env -> String -> Ty -> Template
+templateSetter typeEnv env memberName UnitTy =
+  Template
+    (FuncTy [VarTy "p", VarTy "t"] (VarTy "p") StaticLifetimeTy)
+    (const (toTemplate "$p $NAME($p p)"))
+    -- Execution of the action passed as an argument is handled in Emit.hs.
+    (const (toTemplate "$DECL { return p; }\n"))
+    (const [])
 templateSetter typeEnv env memberName memberTy =
   let callToDelete = memberDeletion typeEnv env (memberName, memberTy)
   in
@@ -149,6 +178,13 @@ templateGenericSetter pathStrings originalStructTy@(StructTy (ConcreteNameTy typ
 
 -- | The template for mutating setters of a deftype.
 templateMutatingSetter :: TypeEnv -> Env -> String -> Ty -> Template
+templateMutatingSetter typeEnv env memberName UnitTy =
+  Template
+    (FuncTy [RefTy (VarTy "p") (VarTy "q"), VarTy "t"] UnitTy StaticLifetimeTy)
+    (const (toTemplate "void $NAME($p* pRef)"))
+    -- Execution of the action passed as an argument is handled in Emit.hs.
+    (const (toTemplate "$DECL { return; }\n"))
+    (const [])
 templateMutatingSetter typeEnv env memberName memberTy =
   let callToDelete = memberRefDeletion typeEnv env (memberName, memberTy)
   in Template
@@ -185,8 +221,16 @@ templateGenericMutatingSetter pathStrings originalStructTy@(StructTy (ConcreteNa
 
 -- | The template for updater functions of a deftype.
 -- | (allows changing a variable by passing an transformation function).
-templateUpdater :: String -> Template
-templateUpdater member =
+templateUpdater :: String -> Ty -> Template
+templateUpdater member UnitTy =
+  Template
+    (FuncTy [VarTy "p", RefTy (FuncTy [] UnitTy (VarTy "fq")) (VarTy "q")] (VarTy "p") StaticLifetimeTy)
+    (const (toTemplate "$p $NAME($p p, Lambda *updater)")) -- "Lambda" used to be: $(Fn [t] t)
+    -- Execution of the action passed as an argument is handled in Emit.hs.
+    (const (toTemplate ("$DECL { " ++ templateCodeForCallingLambda "(*updater)" (FuncTy [] UnitTy (VarTy "fq")) [] ++ "; return p;}\n")))
+    (\(FuncTy [_, RefTy t@(FuncTy fArgTys fRetTy _) _] _ _) ->
+      [defineFunctionTypeAlias t, defineFunctionTypeAlias (FuncTy (lambdaEnvTy : fArgTys) fRetTy StaticLifetimeTy)])
+templateUpdater member _ =
   Template
     (FuncTy [VarTy "p", RefTy (FuncTy [VarTy "t"] (VarTy "t") (VarTy "fq")) (VarTy "q")] (VarTy "p") StaticLifetimeTy)
     (const (toTemplate "$p $NAME($p p, Lambda *updater)")) -- "Lambda" used to be: $(Fn [t] t)
@@ -211,7 +255,8 @@ binderForInit insidePath structTy@(StructTy (ConcreteNameTy typeName) _) [XObj (
 
 -- | Generate a list of types from a deftype declaration.
 initArgListTypes :: [XObj] -> [Ty]
-initArgListTypes xobjs = map (\(_, x) -> fromJust (xobjToTy x)) (pairwise xobjs)
+initArgListTypes xobjs =
+  (map (fromJust . xobjToTy . snd) (pairwise xobjs))
 
 -- | The template for the 'init' and 'new' functions for a concrete deftype.
 concreteInit :: AllocationMode -> Ty -> [XObj] -> Template
@@ -222,9 +267,13 @@ concreteInit allocationMode originalStructTy@(StructTy (ConcreteNameTy typeName)
      let mappings = unifySignatures originalStructTy concreteStructTy
          correctedMembers = replaceGenericTypeSymbolsOnMembers mappings membersXObjs
          memberPairs = memberXObjsToPairs correctedMembers
-     in  (toTemplate $ "$p $NAME(" ++ joinWithComma (map memberArg memberPairs) ++ ")"))
-    (const (tokensForInit allocationMode typeName membersXObjs))
+     in  (toTemplate $ "$p $NAME(" ++ joinWithComma (map memberArg (unitless memberPairs)) ++ ")"))
+    (\(FuncTy _ concreteStructTy _) ->
+      let mappings = unifySignatures originalStructTy concreteStructTy
+          correctedMembers = replaceGenericTypeSymbolsOnMembers mappings membersXObjs
+      in (tokensForInit allocationMode typeName correctedMembers))
     (\FuncTy{} -> [])
+  where unitless = filter (notUnit . snd)
 
 -- | The template for the 'init' and 'new' functions for a generic deftype.
 genericInit :: AllocationMode -> [String] -> Ty -> [XObj] -> (String, Binder)
@@ -241,8 +290,11 @@ genericInit allocationMode pathStrings originalStructTy@(StructTy (ConcreteNameT
                let mappings = unifySignatures originalStructTy concreteStructTy
                    correctedMembers = replaceGenericTypeSymbolsOnMembers mappings membersXObjs
                    memberPairs = memberXObjsToPairs correctedMembers
-               in  (toTemplate $ "$p $NAME(" ++ joinWithComma (map memberArg memberPairs) ++ ")"))
-            (const (tokensForInit allocationMode typeName membersXObjs))
+               in  (toTemplate $ "$p $NAME(" ++ joinWithComma (map memberArg (filter (notUnit . snd) memberPairs)) ++ ")"))
+            (\(FuncTy _ concreteStructTy _) ->
+              let mappings = unifySignatures originalStructTy concreteStructTy
+                  correctedMembers = replaceGenericTypeSymbolsOnMembers mappings membersXObjs
+              in (tokensForInit allocationMode typeName correctedMembers))
             (\(FuncTy _ concreteStructTy _) ->
                case concretizeType typeEnv concreteStructTy of
                  Left err -> error (show err ++ ". This error should not crash the compiler - change return type to Either here.")
@@ -253,14 +305,21 @@ tokensForInit :: AllocationMode -> String -> [XObj] -> [Token]
 tokensForInit allocationMode typeName membersXObjs =
   toTemplate $ unlines [ "$DECL {"
                        , case allocationMode of
-                           StackAlloc -> "    $p instance;"
+                           StackAlloc -> case unitless of
+                                           -- if this is truly a memberless struct, init it to 0;
+                                           -- This can happen, e.g. in cases where *all* members of the struct are of type Unit.
+                                           -- Since we do not generate members for Unit types.
+                                           [] ->  "    $p instance = {0};"
+                                           _  -> "    $p instance;"
                            HeapAlloc ->  "    $p instance = CARP_MALLOC(sizeof(" ++ typeName ++ "));"
                        , assignments membersXObjs
                        , "    return instance;"
                        , "}"]
-  where assignments [] =  "    instance.__dummy = 0;"
-        assignments xobjs = joinLines $ memberAssignment allocationMode . fst <$> memberXObjsToPairs xobjs
-
+  where assignments [] =  "    instance = {0};"
+        assignments xobjs = go $ unitless
+          where go [] = ""
+                go xobjs = joinLines $ memberAssignment allocationMode . fst <$> xobjs
+        unitless = filter (notUnit . snd) (memberXObjsToPairs membersXObjs)
 
 -- | Creates the C code for an arg to the init function.
 -- | i.e. "(deftype A [x Int])" will generate "int x" which

src/Emit.hs

@@ -13,7 +13,7 @@ import Control.Monad.State
 import Control.Monad (when, zipWithM_)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, fromJust)
 import Debug.Trace
 import Data.Char (ord)
 
@@ -316,6 +316,8 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                     -- This requires a bunch of extra machinery though, so this will do for now...
                     [var ++ periodOrArrow ++ "_tag == " ++ tagName caseTy (removeSuffix caseName)] ++
                       concat (zipWith (\c i -> tagCondition (var ++ periodOrArrow ++ "u." ++ removeSuffix caseName ++ ".member" ++ show i) "." (forceTy c) c) caseMatchers [0..])
+                      where notUnitX (XObj _ _ (Just UnitTy)) = False
+                            notUnitX _ = True
                   tagCondition _ _ _ x =
                     []
                     --error ("tagCondition fell through: " ++ show x)
@@ -354,7 +356,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                                MatchRef -> ("->", "&")
                        appendToSrc ("if(" ++ joinWith " && " (tagCondition exprVar (fst refModifications) (removeOuterRefTyIfMatchRef exprTy) caseLhs) ++ ") {\n")
                        appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++ tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
-                       zipWithM_ (emitCaseMatcher refModifications (removeSuffix caseName)) caseMatchers [0..]
+                       zipWithM_ (emitCaseMatcher refModifications (removeSuffix caseName)) (filter (notUnit . forceTy) caseMatchers) [0..]
                        appendToSrc (addIndent indent' ++ "// Case expr:\n")
                        emitCaseEnd caseLhsInfo caseExpr
                   emitCase exprVar isFirst (XObj (Sym firstPath _) caseLhsInfo _, caseExpr) =
@@ -604,11 +606,15 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
 
         createArgList :: Int -> Bool -> [XObj] -> State EmitterState String
         createArgList indent unwrapLambdas args =
-          do argStrings <- mapM (visit indent) args
+          do argStrings <- mapM (visit indent) (filter (notUnit . forceTy) args)
              let argTypes = map forceTy args
-             return $ intercalate ", " $ if unwrapLambdas
-                                         then zipWith unwrapLambda argStrings argTypes
-                                         else argStrings
+                 unitless = filter notUnit argTypes
+                 -- Run side effects
+                 sideEffects = mapM (visit indent) (filter (not . notUnit . forceTy) args) >>= return . intercalate ";\n"
+                 unwrapped = joinWithComma $ if unwrapLambdas
+                                             then zipWith unwrapLambda argStrings unitless
+                                             else argStrings
+             sideEffects >> return unwrapped
 
         unwrapLambda :: String -> Ty -> String
         unwrapLambda variableName ty =
@@ -716,7 +722,7 @@ defStructToDeclaration structTy@(StructTy typeName typeVariables) path rest =
       typedefCaseToMemberDecl :: XObj -> State EmitterState [()]
       -- ANSI C doesn't allow empty structs, insert a dummy member to keep the compiler happy.
       typedefCaseToMemberDecl (XObj (Arr []) _ _) = sequence $ pure $ appendToSrc (addIndent indent ++ "char __dummy;\n")
-      typedefCaseToMemberDecl (XObj (Arr members) _ _) = mapM (memberToDecl indent) (pairwise members)
+      typedefCaseToMemberDecl (XObj (Arr members) _ _) = mapM (memberToDecl indent) (filter (notUnit . fromJust . xobjToTy . snd) (pairwise members))
       typedefCaseToMemberDecl _ = error "Invalid case in typedef."
 
       -- Note: the names of types are not namespaced
@@ -746,7 +752,7 @@ defSumtypeToDeclaration sumTy@(StructTy typeName typeVariables) path rest =
         appendToSrc (addIndent indent ++ "// " ++ caseName ++ "\n")
       emitSumtypeCase indent xobj@(XObj (Lst [XObj (Sym (SymPath [] caseName) _) _ _, XObj (Arr memberTys) _ _]) _ _) =
         do appendToSrc (addIndent indent ++ "struct {\n")
-           let members = zipWith (\anonName tyXObj -> (anonName, tyXObj)) anonMemberSymbols memberTys
+           let members = zipWith (\anonName tyXObj -> (anonName, tyXObj)) anonMemberSymbols (filter (notUnit . fromJust . xobjToTy) memberTys)
            mapM_ (memberToDecl (indent + indentAmount)) members
            appendToSrc (addIndent indent ++ "} " ++ caseName ++ ";\n")
       emitSumtypeCase indent xobj@(XObj (Sym (SymPath [] caseName) _) _ _) =
@@ -766,8 +772,10 @@ defaliasToDeclaration :: Ty -> SymPath -> String
 defaliasToDeclaration t path =
   case t of
     (FuncTy argTys retTy _) -> "typedef " ++ tyToCLambdaFix retTy ++ "(*" ++ pathToC path ++ ")(" ++
-                               intercalate ", " (map tyToCLambdaFix argTys) ++ ");\n"
+                               intercalate ", " (map fixer argTys) ++ ");\n"
     _ ->  "typedef " ++ tyToC t ++ " " ++ pathToC path ++ ";\n"
+    where fixer UnitTy = "void*"
+          fixer x = tyToCLambdaFix x
 
 toDeclaration :: Binder -> String
 toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ t)) =
@@ -811,12 +819,12 @@ toDeclaration (Binder meta xobj@(XObj (Lst xobjs) _ t)) =
 toDeclaration _ = error "Missing case."
 
 paramListToC :: [XObj] -> String
-paramListToC xobjs = intercalate ", " (map getParam (filter notUnit xobjs))
+paramListToC xobjs = if null $ joinWithComma (map getParam xobjs)
+                     then ""
+                     else joinWithComma (map getParam (filter (notUnit . forceTy) xobjs))
   where getParam :: XObj -> String
         getParam (XObj (Sym (SymPath _ name) _) _ (Just t)) = tyToCLambdaFix t ++ " " ++ mangle name
         getParam invalid = error (show (InvalidParameter invalid))
-        notUnit (XObj _ _ (Just UnitTy)) = False
-        notUnit _ = True
 
 projectIncludesToC :: Project -> String
 projectIncludesToC proj = intercalate "\n" (map includerToC includes) ++ "\n\n"

src/Obj.hs

@@ -582,6 +582,7 @@ incrementEnvNestLevel env = let current = envFunctionNestingLevel env
 
 -- | Converts an S-expression to one of the Carp types.
 xobjToTy :: XObj -> Maybe Ty
+xobjToTy (XObj (Sym (SymPath _ "Unit") _) _ _) = Just UnitTy
 xobjToTy (XObj (Sym (SymPath _ "Int") _) _ _) = Just IntTy
 xobjToTy (XObj (Sym (SymPath _ "Float") _) _ _) = Just FloatTy
 xobjToTy (XObj (Sym (SymPath _ "Double") _) _ _) = Just DoubleTy

src/Sumtypes.hs

@@ -73,7 +73,7 @@ concreteCaseInit allocationMode insidePath structTy sumtypeCase =
           (\(FuncTy _ concreteStructTy _) ->
              let mappings = unifySignatures structTy concreteStructTy
                  correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
-             in  (toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames correctedTys) ++ ")"))
+             in  (toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames (filter notUnit correctedTys)) ++ ")"))
           (const (tokensForCaseInit allocationMode structTy sumtypeCase))
           (\FuncTy{} -> [])
 
@@ -90,26 +90,28 @@ genericCaseInit allocationMode pathStrings originalStructTy sumtypeCase =
             (\(FuncTy _ concreteStructTy _) ->
                let mappings = unifySignatures originalStructTy concreteStructTy
                    correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
-               in  toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames correctedTys) ++ ")")
+               in  toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames (filter notUnit correctedTys)) ++ ")")
             (\(FuncTy _ concreteStructTy _) ->
-               tokensForCaseInit allocationMode concreteStructTy sumtypeCase)
+               let mappings = unifySignatures originalStructTy concreteStructTy
+                   correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
+               in tokensForCaseInit allocationMode concreteStructTy (sumtypeCase {caseTys = correctedTys}))
             (\(FuncTy _ concreteStructTy _) ->
                case concretizeType typeEnv concreteStructTy of
                  Left err -> error (show err ++ ". This error should not crash the compiler - change return type to Either here.")
                  Right ok -> ok)
 
-
 tokensForCaseInit :: AllocationMode -> Ty -> SumtypeCase -> [Token]
 tokensForCaseInit allocationMode sumTy@(StructTy (ConcreteNameTy typeName) typeVariables) sumtypeCase =
   toTemplate $ unlines [ "$DECL {"
                        , case allocationMode of
                            StackAlloc -> "    $p instance;"
                            HeapAlloc ->  "    $p instance = CARP_MALLOC(sizeof(" ++ typeName ++ "));"
-                       , joinLines $ caseMemberAssignment allocationMode correctedName . fst <$> zip anonMemberNames (caseTys sumtypeCase)
+                       , joinLines $ caseMemberAssignment allocationMode correctedName . fst <$> unitless
                        , "    instance._tag = " ++ tagName sumTy correctedName ++ ";"
                        , "    return instance;"
                        , "}"]
   where correctedName = caseName sumtypeCase
+        unitless = zip anonMemberNames $ filter notUnit (caseTys sumtypeCase)
 
 caseMemberAssignment :: AllocationMode -> String -> String -> String
 caseMemberAssignment allocationMode caseName memberName =
@@ -194,9 +196,10 @@ tokensForStr typeEnv env typeName cases concreteStructTy  =
                        , "  return buffer;"
                        , "}"]
 
+namesFromCase :: SumtypeCase -> Ty -> (String, [Ty], String)
 namesFromCase theCase concreteStructTy =
   let name = caseName theCase
-  in (name, caseTys theCase, tagName concreteStructTy name)
+  in (name, caseTys theCase {caseTys = (filter notUnit (caseTys theCase))}, tagName concreteStructTy name)
 
 strCase :: TypeEnv -> Env -> Ty -> SumtypeCase -> String
 strCase typeEnv env concreteStructTy@(StructTy _ typeVariables) theCase =

src/Types.hs

@@ -20,6 +20,7 @@ module Types ( TypeMappings
              , consPath
              , Kind
              , tyToKind
+             , notUnit
              ) where
 
 import qualified Data.Map as Map
@@ -260,3 +261,7 @@ isFullyGenericType _ = False
 -- | The type of environments sent to Lambdas (used in emitted C code)
 lambdaEnvTy :: Ty
 lambdaEnvTy = StructTy (ConcreteNameTy "LambdaEnv") []
+
+notUnit :: Ty -> Bool
+notUnit UnitTy = False
+notUnit _ = True

src/Validate.hs

@@ -35,6 +35,7 @@ okXObjForType typeEnv typeVariables xobj =
 canBeUsedAsMemberType :: TypeEnv -> [Ty] -> Ty -> XObj -> Either TypeError ()
 canBeUsedAsMemberType typeEnv typeVariables t xobj =
   case t of
+    UnitTy    -> return ()
     IntTy     -> return ()
     FloatTy   -> return ()
     DoubleTy  -> return ()