Merge pull request #967 from scolsen/unit-members

Allow Unit to be used as a member type in deftypes

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 = {};"
+                                           _  -> "    $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.__dummy = 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

@@ -586,6 +586,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 ()