refactor: add type candidates and template generators (#1361)

* refactor: add type candidates for validation

This commit adds a new module and type, the TypeCandidate, which
represents a potentially valid or invalid type. We use it as the
input for both type validation routines and type binding generation. The
type also allows us to unify the structure of sum types and product
types in an xobj agnostic way, paving the way for future simplification
of binding generation for type definitions.

This commit also removes SumtypeCase.hs, since it's no longer needed.

* refactor: add template generators; update type templates

This commit builds on the TypeCandidate data structure further by
providing "template generators" that work on candidates. Using
generators, templates for type functions ("methods") can be written
almost completely declaratively. Generators also remove some of the
typical boilerplate involved in creating templates from lists of tokens
and enable us to unify several of the generic and concrete templates for
types.

Generators can act on type candidates or their fields (for
field-specific functions). In general, this approach makes the
generation of type templates more structured. A type candidate now
contains all the information a generator needs to create appropriate
templates, thus it is a single and well-defined input for validation and
generation of user defined types.

This commit also updates the Deftype templates to use template
generators.

* refactor: use template generators for sumtype templates

CarpHask.cabal

@@ -56,11 +56,12 @@ library
                        StartingEnv,
                        StaticArrayTemplates,
                        StructUtils,
-                       SumtypeCase,
                        Sumtypes,
                        SymPath,
                        Template,
+                       TemplateGenerator,
                        ToTemplate,
+                       TypeCandidate,
                        TypeError,
                        TypePredicates,
                        Types,

src/Concretize.hs

@@ -19,6 +19,7 @@ module Concretize
     tokensForCopy,
     memberCopy,
     replaceGenericTypeSymbolsOnMembers,
+    replaceGenericTypeSymbolsOnFields,
   )
 where
 
@@ -41,7 +42,6 @@ import Obj
 import Polymorphism
 import Reify
 import qualified Set
-import SumtypeCase
 import ToTemplate
 import TypeError
 import TypePredicates
@@ -50,6 +50,7 @@ import TypesToC
 import Util
 import Validate
 import Prelude hiding (lookup)
+import qualified TypeCandidate as TC
 
 data Level = Toplevel | Inside
 
@@ -612,7 +613,9 @@ instantiateGenericStructType typeEnv env originalStructTy@(StructTy _ _) generic
       let nameFixedMembers = renameGenericTypeSymbolsOnProduct renamedOrig memberXObjs
           validMembers = replaceGenericTypeSymbolsOnMembers mappings' nameFixedMembers
           concretelyTypedMembers = replaceGenericTypeSymbolsOnMembers mappings memberXObjs
-      validateMembers AllowAnyTypeVariableNames typeEnv env renamedOrig validMembers
+          sname = getStructName originalStructTy
+      candidate <- TC.mkStructCandidate sname renamedOrig typeEnv env validMembers (getPathFromStructName sname)
+      validateType (TC.setRestriction candidate TC.AllowAny)
       deps <- mapM (depsForStructMemberPair typeEnv env) (pairwise concretelyTypedMembers)
       let xobj =
             XObj
@@ -640,29 +643,24 @@ instantiateGenericSumtype typeEnv env originalStructTy@(StructTy _ originalTyVar
   let fake1 = XObj (Sym (SymPath [] "a") Symbol) Nothing Nothing
       fake2 = XObj (Sym (SymPath [] "b") Symbol) Nothing Nothing
       rename@(StructTy _ renamedOrig) = evalState (renameVarTys originalStructTy) 0
-   in case solve [Constraint rename genericStructTy fake1 fake2 fake1 OrdMultiSym] of
+      nameFixedCases = map (renameGenericTypeSymbolsOnSum (zip originalTyVars renamedOrig)) cases
-        Left e -> error (show e)
+      fixLeft l = replaceLeft (FailedToInstantiateGenericType originalStructTy) l
-        Right mappings ->
+   in do mappings <- fixLeft $ solve [Constraint rename genericStructTy fake1 fake2 fake1 OrdMultiSym]
-          let nameFixedCases = map (renameGenericTypeSymbolsOnSum (zip originalTyVars renamedOrig)) cases
+         let concretelyTypedCases = map (replaceGenericTypeSymbolsOnCase mappings) nameFixedCases
-              concretelyTypedCases = map (replaceGenericTypeSymbolsOnCase mappings) nameFixedCases
+             sname = (getStructName originalStructTy)
-              deps = mapM (depsForCase typeEnv env) concretelyTypedCases
+         deps <- mapM (depsForCase typeEnv env) concretelyTypedCases
-           in case toCases typeEnv env AllowAnyTypeVariableNames renamedOrig concretelyTypedCases of -- Don't care about the cases, this is done just for validation.
+         candidate <- TC.mkSumtypeCandidate sname renamedOrig typeEnv env concretelyTypedCases (getPathFromStructName sname)
-                Left err -> Left err
+         validateType (TC.setRestriction candidate TC.AllowAny)
-                Right _ ->
+         pure (XObj
-                  case deps of
+               ( Lst
-                    Right okDeps ->
+                   ( XObj (DefSumtype genericStructTy) Nothing Nothing :
-                      Right $
+                     XObj (Sym (SymPath [] (tyToC genericStructTy)) Symbol) Nothing Nothing :
-                        XObj
+                     concretelyTypedCases
-                          ( Lst
+                   )
-                              ( XObj (DefSumtype genericStructTy) Nothing Nothing :
+               )
-                                XObj (Sym (SymPath [] (tyToC genericStructTy)) Symbol) Nothing Nothing :
+               (Just dummyInfo)
-                                concretelyTypedCases
+               (Just TypeTy) :
-                              )
+              concat deps)
-                          )
-                          (Just dummyInfo)
-                          (Just TypeTy) :
-                        concat okDeps
-                    Left err -> Left err
 instantiateGenericSumtype _ _ _ _ _ = error "instantiategenericsumtype"
 
 -- Resolves dependencies for sumtype cases.
@@ -677,6 +675,12 @@ depsForCase typeEnv env (XObj (Lst [_, XObj (Arr members) _ _]) _ _) =
       members
 depsForCase _ _ x = Left (InvalidSumtypeCase x)
 
+-- | Replace instances of generic types in type candidate field definitions.
+replaceGenericTypeSymbolsOnFields :: Map.Map String Ty -> [TC.TypeField] -> [TC.TypeField]
+replaceGenericTypeSymbolsOnFields ms fields = map go fields
+  where go (TC.StructField name t) = (TC.StructField name (replaceTyVars ms t))
+        go (TC.SumField name ts) = (TC.SumField name (map (replaceTyVars ms) ts))
+
 replaceGenericTypeSymbolsOnMembers :: Map.Map String Ty -> [XObj] -> [XObj]
 replaceGenericTypeSymbolsOnMembers mappings memberXObjs =
   concatMap (\(v, t) -> [v, replaceGenericTypeSymbols mappings t]) (pairwise memberXObjs)

src/SumtypeCase.hs

@@ -1,41 +0,0 @@
-module SumtypeCase where
-
-import Obj
-import TypeError
-import Types
-import Validate
-
-data SumtypeCase = SumtypeCase
-  { caseName :: String,
-    caseTys :: [Ty]
-  }
-  deriving (Show, Eq)
-
-toCases :: TypeEnv -> Env -> TypeVarRestriction -> [Ty] -> [XObj] -> Either TypeError [SumtypeCase]
-toCases typeEnv globalEnv restriction typeVars = mapM (toCase typeEnv globalEnv restriction typeVars)
-
-toCase :: TypeEnv -> Env -> TypeVarRestriction -> [Ty] -> XObj -> Either TypeError SumtypeCase
-toCase typeEnv globalEnv restriction typeVars x@(XObj (Lst [XObj (Sym (SymPath [] name) Symbol) _ _, XObj (Arr tyXObjs) _ _]) _ _) =
-  let tys = map xobjToTy tyXObjs
-   in case sequence tys of
-        Nothing ->
-          Left (InvalidSumtypeCase x)
-        Just okTys ->
-          let validated = map (\t -> canBeUsedAsMemberType restriction typeEnv globalEnv typeVars t x) okTys
-           in case sequence validated of
-                Left e ->
-                  Left e
-                Right _ ->
-                  Right $
-                    SumtypeCase
-                      { caseName = name,
-                        caseTys = okTys
-                      }
-toCase _ _ _ _ (XObj (Sym (SymPath [] name) Symbol) _ _) =
-  Right $
-    SumtypeCase
-      { caseName = name,
-        caseTys = []
-      }
-toCase _ _ _ _ x =
-  Left (InvalidSumtypeCase x)

src/Sumtypes.hs

@@ -1,4 +1,11 @@
-module Sumtypes where
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Sumtypes
+  (
+   moduleForSumtypeInContext,
+   moduleForSumtype
+  )
+where
 
 import Concretize
 import Context
@@ -9,7 +16,6 @@ import Info
 import Managed
 import Obj
 import StructUtils
-import SumtypeCase
 import Template
 import ToTemplate
 import TypeError
@@ -17,14 +23,14 @@ import TypePredicates
 import Types
 import TypesToC
 import Util
-import Validate (TypeVarRestriction (..))
+import Validate
+import qualified TypeCandidate as TC
+import TemplateGenerator as TG
 
-getCase :: [SumtypeCase] -> String -> Maybe SumtypeCase
+--------------------------------------------------------------------------------
-getCase cases caseNameToFind =
+-- Public
-  case filter (\c -> caseName c == caseNameToFind) cases of
-    found : _ -> Just found
-    [] -> Nothing
 
+-- | Creates a module and generates standard functions for a user defined sum type in the given context.
 moduleForSumtypeInContext :: Context -> String -> [Ty] -> [XObj] -> Maybe Info -> Either TypeError (String, XObj, [XObj])
 moduleForSumtypeInContext ctx name vars members info =
   let global = contextGlobalEnv ctx
@@ -47,402 +53,396 @@ moduleForSumtypeInContext ctx name vars members info =
           )
    in moduleForSumtype inner types global path name vars members info previous
 
+-- | Creates a module and generates standard functions for a user defined sum type.
 moduleForSumtype :: Maybe Env -> TypeEnv -> Env -> [String] -> String -> [Ty] -> [XObj] -> Maybe Info -> Maybe (Env, TypeEnv) -> Either TypeError (String, XObj, [XObj])
 moduleForSumtype innerEnv typeEnv env pathStrings typeName typeVariables rest i existingEnv =
   let moduleValueEnv = fromMaybe (new innerEnv (Just typeName)) (fmap fst existingEnv)
       moduleTypeEnv = fromMaybe (new (Just typeEnv) (Just typeName)) (fmap snd existingEnv)
-      insidePath = pathStrings ++ [typeName]
    in do
-        let structTy = StructTy (ConcreteNameTy (SymPath pathStrings typeName)) typeVariables
+        -- validate the definition
-        cases <- toCases typeEnv env AllowOnlyNamesInScope typeVariables rest
+        candidate <- TC.mkSumtypeCandidate typeName typeVariables typeEnv env rest pathStrings
-        okIniters <- initers insidePath structTy cases
+        validateType candidate
-        okTag <- binderForTag insidePath structTy
+        -- produce standard function bindings
-        (okStr, okStrDeps) <- binderForStrOrPrn typeEnv env insidePath structTy cases "str"
+        (binders, deps) <- generateBinders candidate
-        (okPrn, _) <- binderForStrOrPrn typeEnv env insidePath structTy cases "prn"
+        -- insert the module into the environment
-        okDelete <- binderForDelete typeEnv env insidePath structTy cases
+        let moduleEnvWithBindings = addListOfBindings moduleValueEnv binders
-        (okCopy, okCopyDeps) <- binderForCopy typeEnv env insidePath structTy cases
-        okMemberDeps <- memberDeps typeEnv env cases
-        let moduleEnvWithBindings = addListOfBindings moduleValueEnv (okIniters ++ [okStr, okPrn, okDelete, okCopy, okTag])
             typeModuleXObj = XObj (Mod moduleEnvWithBindings moduleTypeEnv) i (Just ModuleTy)
-        pure (typeName, typeModuleXObj, okMemberDeps ++ okCopyDeps ++ okStrDeps)
+        pure (typeName, typeModuleXObj, deps)
 
-memberDeps :: TypeEnv -> Env -> [SumtypeCase] -> Either TypeError [XObj]
+--------------------------------------------------------------------------------
-memberDeps typeEnv env cases = fmap concat (mapM (concretizeType typeEnv env) (concatMap caseTys cases))
+-- Private
 
-replaceGenericTypesOnCases :: TypeMappings -> [SumtypeCase] -> [SumtypeCase]
+-- | Generate standard binders for the sumtype
+generateBinders :: TC.TypeCandidate -> Either TypeError ([(String, Binder)], [XObj])
+generateBinders candidate =
+  do okIniters <- initers candidate
+     okTag <- binderForTag candidate
+     (okStr, okStrDeps) <- binderForStrOrPrn candidate "str"
+     (okPrn, _) <- binderForStrOrPrn candidate "prn"
+     okDelete <- binderForDelete candidate
+     (okCopy, okCopyDeps) <- binderForCopy candidate
+     okMemberDeps <- memberDeps (TC.getTypeEnv candidate) (TC.getValueEnv candidate) (TC.getFields candidate)
+     let binders = okIniters ++ [okStr, okPrn, okDelete, okCopy, okTag]
+         deps = okMemberDeps ++ okCopyDeps ++ okStrDeps
+     pure (binders, deps)
+
+-- | Gets concrete dependencies for sum type fields.
+memberDeps :: TypeEnv -> Env -> [TC.TypeField] -> Either TypeError [XObj]
+memberDeps typeEnv env cases = fmap concat (mapM (concretizeType typeEnv env) (concatMap TC.fieldTypes cases))
+
+-- | Replace type variables in a sum type case
+replaceGenericTypesOnCases :: TypeMappings -> [TC.TypeField] -> [TC.TypeField]
 replaceGenericTypesOnCases mappings = map replaceOnCase
   where
-    replaceOnCase theCase =
+    replaceOnCase :: TC.TypeField -> TC.TypeField
-      let newTys = map (replaceTyVars mappings) (caseTys theCase)
+    replaceOnCase (TC.SumField name tys) =
-       in theCase {caseTys = newTys}
+      let newTys = map (replaceTyVars mappings) tys
+       in (TC.SumField name newTys)
+    replaceOnCase field = field
 
-initers :: [String] -> Ty -> [SumtypeCase] -> Either TypeError [(String, Binder)]
+--------------------------------------------------------------------------------
-initers insidePath structTy = mapM (binderForCaseInit insidePath structTy)
+-- Binding generators
 
-binderForCaseInit :: [String] -> Ty -> SumtypeCase -> Either TypeError (String, Binder)
+type BinderGen = TC.TypeCandidate -> Either TypeError (String, Binder)
-binderForCaseInit insidePath structTy@(StructTy (ConcreteNameTy _) _) sumtypeCase =
+type BinderGenDeps = TC.TypeCandidate -> Either TypeError ((String, Binder), [XObj])
-  if isTypeGeneric structTy
+type MultiBinderGen = TC.TypeCandidate -> Either TypeError [(String, Binder)]
-    then Right (genericCaseInit StackAlloc insidePath structTy sumtypeCase)
-    else Right (concreteCaseInit StackAlloc insidePath structTy sumtypeCase)
-binderForCaseInit _ _ _ = error "binderforcaseinit"
 
-concreteCaseInit :: AllocationMode -> [String] -> Ty -> SumtypeCase -> (String, Binder)
+-- | Generate initializer bindings for each sum type case.
-concreteCaseInit allocationMode insidePath structTy sumtypeCase =
+initers :: MultiBinderGen
-  instanceBinder (SymPath insidePath (caseName sumtypeCase)) (FuncTy (caseTys sumtypeCase) structTy StaticLifetimeTy) template doc
+initers candidate = mapM binderForCaseInit (TC.getFields candidate)
   where
-    doc = "creates a `" ++ caseName sumtypeCase ++ "`."
+    -- | Generate an initializer binding for a single sum type case, using the given candidate.
-    template =
+    binderForCaseInit :: TC.TypeField -> Either TypeError (String, Binder)
-      Template
+    binderForCaseInit sumtypeCase =
-        (FuncTy (caseTys sumtypeCase) (VarTy "p") StaticLifetimeTy)
+      if isTypeGeneric (TC.toType candidate)
-        ( \(FuncTy _ concreteStructTy _) ->
+        then Right (genericCaseInit StackAlloc sumtypeCase)
-            let mappings = unifySignatures structTy concreteStructTy
+        else Right (concreteCaseInit StackAlloc sumtypeCase)
-                correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
-             in (toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames (remove isUnit correctedTys)) ++ ")")
-        )
-        (const (tokensForCaseInit allocationMode structTy sumtypeCase))
-        (\FuncTy {} -> [])
 
-genericCaseInit :: AllocationMode -> [String] -> Ty -> SumtypeCase -> (String, Binder)
+    -- | Generates a template for a concrete (no type variables) sum type case.
-genericCaseInit allocationMode pathStrings originalStructTy sumtypeCase =
+    concreteCaseInit :: AllocationMode -> TC.TypeField -> (String, Binder)
-  defineTypeParameterizedTemplate templateCreator path t docs
+    concreteCaseInit alloc field@(TC.SumField fieldname tys) =
-  where
+      let concrete = (TC.toType candidate)
-    path = SymPath pathStrings (caseName sumtypeCase)
+          doc      = "creates a `" ++ fieldname ++ "`."
-    t = FuncTy (caseTys sumtypeCase) originalStructTy StaticLifetimeTy
+          t        = (FuncTy tys (VarTy "p") StaticLifetimeTy)
-    docs = "creates a `" ++ caseName sumtypeCase ++ "`."
+          decl     = (const (tokensForCaseInitDecl concrete concrete field))
-    templateCreator = TemplateCreator $
+          body     = (const (tokensForCaseInit alloc concrete concrete field))
-      \typeEnv env ->
+          deps     = (const [])
-        Template
+          temp     = Template t decl body deps
-          (FuncTy (caseTys sumtypeCase) (VarTy "p") StaticLifetimeTy)
+          binderPath = SymPath (TC.getFullPath candidate) fieldname
-          ( \(FuncTy _ concreteStructTy _) ->
+       in instanceBinder binderPath (FuncTy tys concrete StaticLifetimeTy) temp doc
-              let mappings = unifySignatures originalStructTy concreteStructTy
+    concreteCaseInit _ _ = error "concreteCaseInit"
-                  correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
-               in toTemplate $ "$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames (remove isUnit correctedTys)) ++ ")"
-          )
-          ( \(FuncTy _ concreteStructTy _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedTys = map (replaceTyVars mappings) (caseTys sumtypeCase)
-               in tokensForCaseInit allocationMode concreteStructTy (sumtypeCase {caseTys = correctedTys})
-          )
-          ( \(FuncTy _ concreteStructTy _) ->
-              case concretizeType typeEnv env concreteStructTy of
-                Left _ -> []
-                Right ok -> ok
-          )
 
-tokensForCaseInit :: AllocationMode -> Ty -> SumtypeCase -> [Token]
+    -- | Generates a template for a generic (has type variables) sum type case.
-tokensForCaseInit allocationMode sumTy@(StructTy (ConcreteNameTy _) _) sumtypeCase =
+    genericCaseInit :: AllocationMode -> TC.TypeField -> (String, Binder)
-  toTemplate $
+    genericCaseInit alloc field@(TC.SumField fieldname tys) =
-    unlines
+      let generic = (TC.toType candidate)
-      [ "$DECL {",
+          docs    = "creates a `" ++ fieldname ++ "`."
-        case allocationMode of
+          ft      = FuncTy tys generic StaticLifetimeTy
-          StackAlloc -> "    $p instance;"
+          binderPath = SymPath (TC.getFullPath candidate) fieldname
-          HeapAlloc -> "    $p instance = CARP_MALLOC(sizeof(" ++ show sumTy ++ "));",
+          t       = (FuncTy tys (VarTy "p") StaticLifetimeTy)
-        joinLines $ caseMemberAssignment allocationMode correctedName . fst <$> unitless,
+          decl    = \(FuncTy _ concrete _) -> tokensForCaseInitDecl generic concrete field
-        "    instance._tag = " ++ tagName sumTy correctedName ++ ";",
+          body    = \(FuncTy _ concrete _) -> tokensForCaseInit alloc generic concrete field
-        "    return instance;",
+          deps tenv env = \(FuncTy _ concrete _) -> either (const []) id (concretizeType tenv env concrete)
-        "}"
+          temp = TemplateCreator $ \tenv env -> Template t decl body (deps tenv env)
-      ]
+       in defineTypeParameterizedTemplate temp binderPath ft docs
-  where
+    genericCaseInit _ _ = error "genericCaseInit"
-    correctedName = caseName sumtypeCase
-    unitless = zip anonMemberNames $ remove isUnit (caseTys sumtypeCase)
-tokensForCaseInit _ _ _ = error "tokensforcaseinit"
 
-caseMemberAssignment :: AllocationMode -> String -> String -> String
+-- | Generates a binder for retrieving the tag of a sum type.
-caseMemberAssignment allocationMode caseNm memberName =
+binderForTag :: BinderGen
-  "    instance" ++ sep ++ caseNm ++ "." ++ memberName ++ " = " ++ memberName ++ ";"
+binderForTag candidate =
+  let t = FuncTy [RefTy (TC.toType candidate) (VarTy "q")] IntTy StaticLifetimeTy
+      decl = \(FuncTy [RefTy struct _] _ _) -> toTemplate $ proto struct
+      body = \(FuncTy [RefTy struct _] _ _) -> toTemplate $ proto struct ++ " { return p->_tag; }"
+      deps = const []
+      path' = SymPath (TC.getFullPath candidate) "get-tag"
+      temp = Template t decl body deps
+      doc = "Gets the tag from a `" ++ (TC.getName candidate) ++ "`."
+   in Right (instanceBinder path' t temp doc)
   where
-    sep = case allocationMode of
+    proto :: Ty -> String
-      StackAlloc -> ".u."
-      HeapAlloc -> "->u."
-
-binderForTag :: [String] -> Ty -> Either TypeError (String, Binder)
-binderForTag insidePath originalStructTy@(StructTy (ConcreteNameTy _) _) =
-  Right $ instanceBinder path (FuncTy [RefTy originalStructTy (VarTy "q")] IntTy StaticLifetimeTy) template doc
-  where
-    path = SymPath insidePath "get-tag"
-    template =
-      Template
-        (FuncTy [RefTy originalStructTy (VarTy "q")] IntTy StaticLifetimeTy)
-        (\(FuncTy [RefTy structTy _] IntTy _) -> toTemplate $ proto structTy)
-        (\(FuncTy [RefTy structTy _] IntTy _) -> toTemplate $ proto structTy ++ " { return p->_tag; }")
-        (const [])
     proto structTy = "int $NAME(" ++ tyToCLambdaFix structTy ++ " *p)"
-    doc = "Gets the tag from a `" ++ show originalStructTy ++ "`."
-binderForTag _ _ = error "binderfortag"
 
 -- | Helper function to create the binder for the 'str' template.
-binderForStrOrPrn :: TypeEnv -> Env -> [String] -> Ty -> [SumtypeCase] -> String -> Either TypeError ((String, Binder), [XObj])
+binderForStrOrPrn :: TC.TypeCandidate -> String -> Either TypeError ((String, Binder), [XObj])
-binderForStrOrPrn typeEnv env insidePath structTy@(StructTy (ConcreteNameTy _) _) cases strOrPrn =
+binderForStrOrPrn candidate strOrPrn =
-  Right $
+  let doc = "converts a `" ++ (getStructName (TC.toType candidate)) ++ "` to a string."
-    if isTypeGeneric structTy
+      binderP = SymPath (TC.getFullPath candidate) strOrPrn
-      then (genericStr insidePath structTy cases strOrPrn, [])
+      binderT = FuncTy [RefTy (TC.toType candidate) (VarTy "q")] StringTy StaticLifetimeTy
-      else concreteStr typeEnv env insidePath structTy cases strOrPrn
+   in Right $
-binderForStrOrPrn _ _ _ _ _ _ = error "binderforstrorprn"
+       if isTypeGeneric (TC.toType candidate)
-
+         then (defineTypeParameterizedTemplate (TG.generateGenericTypeTemplate candidate strGenerator) binderP binderT doc, [])
--- | The template for the 'str' function for a concrete deftype.
+         else instanceBinderWithDeps binderP binderT (TG.generateConcreteTypeTemplate candidate strGenerator) doc
-concreteStr :: TypeEnv -> Env -> [String] -> Ty -> [SumtypeCase] -> String -> ((String, Binder), [XObj])
-concreteStr typeEnv env insidePath concreteStructTy@(StructTy (ConcreteNameTy name) _) cases strOrPrn =
-  instanceBinderWithDeps (SymPath insidePath strOrPrn) (FuncTy [RefTy concreteStructTy (VarTy "q")] StringTy StaticLifetimeTy) template doc
   where
-    doc = "converts a `" ++ (show concreteStructTy) ++ "` to a string."
+    strGenerator :: TG.TemplateGenerator TC.TypeCandidate
-    template =
+    strGenerator = TG.mkTemplateGenerator genT decl body deps
-      Template
-        (FuncTy [RefTy concreteStructTy (VarTy "q")] StringTy StaticLifetimeTy)
-        (\(FuncTy [RefTy structTy _] StringTy _) -> toTemplate $ "String $NAME(" ++ tyToCLambdaFix structTy ++ " *p)")
-        ( \(FuncTy [RefTy (StructTy _ _) _] StringTy _) ->
-            tokensForStr typeEnv env (show name) cases concreteStructTy
-        )
-        ( \(FuncTy [RefTy (StructTy _ _) _] StringTy _) ->
-            concatMap
-              (depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env)
-              (remove isFullyGenericType (concatMap caseTys cases))
-        )
-concreteStr _ _ _ _ _ _ = error "concretestr"
 
--- | The template for the 'str' function for a generic deftype.
+    genT :: TG.TypeGenerator TC.TypeCandidate
-genericStr :: [String] -> Ty -> [SumtypeCase] -> String -> (String, Binder)
+    genT GeneratorArg{value} =
-genericStr insidePath originalStructTy@(StructTy (ConcreteNameTy name) _) cases strOrPrn =
+      FuncTy [RefTy (TC.toType value) (VarTy "q")] StringTy StaticLifetimeTy
-  defineTypeParameterizedTemplate templateCreator path t docs
-  where
-    path = SymPath insidePath strOrPrn
-    t = FuncTy [RefTy originalStructTy (VarTy "q")] StringTy StaticLifetimeTy
-    docs = "stringifies a `" ++ show originalStructTy ++ "`."
-    templateCreator = TemplateCreator $
-      \typeEnv env ->
-        Template
-          t
-          ( \(FuncTy [RefTy concreteStructTy _] StringTy _) ->
-              toTemplate $ "String $NAME(" ++ tyToCLambdaFix concreteStructTy ++ " *p)"
-          )
-          ( \(FuncTy [RefTy concreteStructTy@(StructTy _ _) _] StringTy _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-               in tokensForStr typeEnv env (show name) correctedCases concreteStructTy
-          )
-          ( \ft@(FuncTy [RefTy concreteStructTy@(StructTy _ _) _] StringTy _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-                  tys = remove isFullyGenericType (concatMap caseTys correctedCases)
-               in concatMap (depsOfPolymorphicFunction typeEnv env [] "prn" . typesStrFunctionType typeEnv env) tys
-                    ++ [defineFunctionTypeAlias ft | not (isTypeGeneric concreteStructTy)]
-          )
-genericStr _ _ _ _ = error "genericstr"
 
-tokensForStr :: TypeEnv -> Env -> String -> [SumtypeCase] -> Ty -> [Token]
+    decl :: TG.TokenGenerator TC.TypeCandidate
-tokensForStr typeEnv env _ cases concreteStructTy =
+    decl GeneratorArg{instanceT=(FuncTy [RefTy ty _] _ _)} =
-  toTemplate $
+      toTemplate $ "String $NAME(" ++ tyToCLambdaFix ty ++ " *p)"
-    unlines
+    decl _ = toTemplate "/* template error! */"
-      [ "$DECL {",
-        "  // convert members to String here:",
-        "  String temp = NULL;",
-        "  int tempsize = 0;",
-        "  (void)tempsize; // that way we remove the occasional unused warning ",
-        calculateStructStrSize typeEnv env cases concreteStructTy,
-        "  String buffer = CARP_MALLOC(size);",
-        "  String bufferPtr = buffer;",
-        "",
-        concatMap (strCase typeEnv env concreteStructTy) cases,
-        "  return buffer;",
-        "}"
-      ]
 
-namesFromCase :: SumtypeCase -> Ty -> (String, [Ty], String)
+    body :: TG.TokenGenerator TC.TypeCandidate
-namesFromCase theCase concreteStructTy =
+    body GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [RefTy ty _] _ _), value} =
-  let name = caseName theCase
+      tokensForStr tenv env originalT ty (TC.getFields value)
-   in (name, caseTys theCase {caseTys = remove isUnit (caseTys theCase)}, tagName concreteStructTy name)
+    body _ = toTemplate "/* template error! */"
 
-strCase :: TypeEnv -> Env -> Ty -> SumtypeCase -> String
+    deps :: TG.DepenGenerator TC.TypeCandidate
-strCase typeEnv env concreteStructTy@(StructTy _ _) theCase =
+    deps GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [RefTy ty _] _ _), value} =
-  let (name, tys, correctedTagName) = namesFromCase theCase concreteStructTy
+      depsForStr tenv env originalT ty (TC.getFields value)
-   in unlines
+    deps _ = []
-        [ "  if(p->_tag == " ++ correctedTagName ++ ") {",
-          "    sprintf(bufferPtr, \"(%s \", \"" ++ name ++ "\");",
-          "    bufferPtr += strlen(\"" ++ name ++ "\") + 2;\n",
-          joinLines $ memberPrn typeEnv env <$> unionMembers name tys,
-          "    bufferPtr--;",
-          "    sprintf(bufferPtr, \")\");",
-          "  }"
-        ]
-strCase _ _ _ _ = error "strcase"
-
--- | Figure out how big the string needed for the string representation of the struct has to be.
-calculateStructStrSize :: TypeEnv -> Env -> [SumtypeCase] -> Ty -> String
-calculateStructStrSize typeEnv env cases structTy@(StructTy (ConcreteNameTy _) _) =
-  "  int size = 1;\n"
-    ++ concatMap (strSizeCase typeEnv env structTy) cases
-calculateStructStrSize _ _ _ _ = error "calculatestructstrsize"
-
-strSizeCase :: TypeEnv -> Env -> Ty -> SumtypeCase -> String
-strSizeCase typeEnv env concreteStructTy@(StructTy _ _) theCase =
-  let (name, tys, correctedTagName) = namesFromCase theCase concreteStructTy
-   in unlines
-        [ "  if(p->_tag == " ++ correctedTagName ++ ") {",
-          "    size += snprintf(NULL, 0, \"(%s \", \"" ++ name ++ "\");",
-          joinLines $ memberPrnSize typeEnv env <$> unionMembers name tys,
-          "  }"
-        ]
-strSizeCase _ _ _ _ = error "strsizecase"
 
 -- | Helper function to create the binder for the 'delete' template.
-binderForDelete :: TypeEnv -> Env -> [String] -> Ty -> [SumtypeCase] -> Either TypeError (String, Binder)
+binderForDelete :: BinderGen
-binderForDelete typeEnv env insidePath structTy@(StructTy (ConcreteNameTy _) _) cases =
+binderForDelete candidate =
-  Right $
+  let t = (TC.toType candidate)
-    if isTypeGeneric structTy
+      doc = "deletes a `" ++ (getStructName t) ++ "`. This should usually not be called manually."
-      then genericSumtypeDelete insidePath structTy cases
+      binderT = FuncTy [t] UnitTy StaticLifetimeTy
-      else concreteSumtypeDelete insidePath typeEnv env structTy cases
+      binderP = SymPath (TC.getFullPath candidate) "delete"
-binderForDelete _ _ _ _ _ = error "binderfordelete"
+   in Right $
-
+        if isTypeGeneric t
--- | The template for the 'delete' function of a generic sumtype.
+          then defineTypeParameterizedTemplate (TG.generateGenericTypeTemplate candidate generator) binderP binderT doc
-genericSumtypeDelete :: [String] -> Ty -> [SumtypeCase] -> (String, Binder)
+          else instanceBinder binderP binderT (TG.generateConcreteTypeTemplate candidate generator) doc
-genericSumtypeDelete pathStrings originalStructTy cases =
-  defineTypeParameterizedTemplate templateCreator path (FuncTy [originalStructTy] UnitTy StaticLifetimeTy) docs
   where
-    path = SymPath pathStrings "delete"
+    generator :: TG.TemplateGenerator TC.TypeCandidate
-    t = FuncTy [VarTy "p"] UnitTy StaticLifetimeTy
+    generator = TG.mkTemplateGenerator genT decl body deps
-    docs = "deletes a `" ++ show originalStructTy ++ "`. Should usually not be called manually."
-    templateCreator = TemplateCreator $
-      \typeEnv env ->
-        Template
-          t
-          (const (toTemplate "void $NAME($p p)"))
-          ( \(FuncTy [concreteStructTy] UnitTy _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-               in ( toTemplate $
-                      unlines
-                        [ "$DECL {",
-                          concatMap (deleteCase typeEnv env concreteStructTy) (zip correctedCases (True : repeat False)),
-                          "}"
-                        ]
-                  )
-          )
-          ( \(FuncTy [concreteStructTy] UnitTy _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-               in if isTypeGeneric concreteStructTy
-                    then []
-                    else
-                      concatMap
-                        (depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
-                        (filter (isManaged typeEnv env) (concatMap caseTys correctedCases))
-          )
 
--- | The template for the 'delete' function of a concrete sumtype
+    genT :: TG.TypeGenerator TC.TypeCandidate
-concreteSumtypeDelete :: [String] -> TypeEnv -> Env -> Ty -> [SumtypeCase] -> (String, Binder)
+    genT _ = (FuncTy [VarTy "p"] UnitTy StaticLifetimeTy)
-concreteSumtypeDelete insidePath typeEnv env structTy@(StructTy (ConcreteNameTy _) _) cases =
-  instanceBinder (SymPath insidePath "delete") (FuncTy [structTy] UnitTy StaticLifetimeTy) template doc
-  where
-    doc = "deletes a `" ++ (show structTy) ++ "`. This should usually not be called manually."
-    template =
-      Template
-        (FuncTy [VarTy "p"] UnitTy StaticLifetimeTy)
-        (const (toTemplate "void $NAME($p p)"))
-        ( const
-            ( toTemplate $
-                unlines
-                  [ "$DECL {",
-                    concatMap (deleteCase typeEnv env structTy) (zip cases (True : repeat False)),
-                    "}"
-                  ]
-            )
-        )
-        ( \_ ->
-            concatMap
-              (depsOfPolymorphicFunction typeEnv env [] "delete" . typesDeleterFunctionType)
-              (filter (isManaged typeEnv env) (concatMap caseTys cases))
-        )
-concreteSumtypeDelete _ _ _ _ _ = error "concretesumtypedelete"
 
-deleteCase :: TypeEnv -> Env -> Ty -> (SumtypeCase, Bool) -> String
+    decl :: TG.TokenGenerator TC.TypeCandidate
-deleteCase typeEnv env concreteStructTy@(StructTy _ _) (theCase, isFirstCase) =
+    decl _ = toTemplate "void $NAME($p p)"
-  let (name, tys, correctedTagName) = namesFromCase theCase concreteStructTy
+
-   in unlines
+    body :: TG.TokenGenerator TC.TypeCandidate
-        [ "  " ++ (if isFirstCase then "" else "else ") ++ "if(p._tag == " ++ correctedTagName ++ ") {",
+    body GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [ty] _ _), value} =
-          joinLines $ memberDeletion typeEnv env <$> unionMembers name tys,
+      tokensForDeleteBody tenv env originalT ty (TC.getFields value)
-          "  }"
+    body _ = toTemplate "/* template error! */"
-        ]
+
-deleteCase _ _ _ _ = error "deletecase"
+    deps :: TG.DepenGenerator TC.TypeCandidate
+    deps GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [ty] _ _), value} =
+      depsForDelete tenv env originalT ty (TC.getFields value)
+    deps _ = []
 
 -- | Helper function to create the binder for the 'copy' template.
-binderForCopy :: TypeEnv -> Env -> [String] -> Ty -> [SumtypeCase] -> Either TypeError ((String, Binder), [XObj])
+binderForCopy :: BinderGenDeps
-binderForCopy typeEnv env insidePath structTy@(StructTy (ConcreteNameTy _) _) cases =
+binderForCopy candidate =
-  Right $
+  let t = TC.toType candidate
-    if isTypeGeneric structTy
+      doc =  "copies a `" ++ (TC.getName candidate) ++ "`."
-      then (genericSumtypeCopy insidePath structTy cases, [])
+      binderT = FuncTy [RefTy t (VarTy "q")] t StaticLifetimeTy
-      else concreteSumtypeCopy insidePath typeEnv env structTy cases
+      binderP = SymPath (TC.getFullPath candidate) "copy"
-binderForCopy _ _ _ _ _ = error "binderforcopy"
+   in Right $
-
+        if isTypeGeneric (TC.toType candidate)
--- | The template for the 'copy' function of a generic sumtype.
+          then (defineTypeParameterizedTemplate (TG.generateGenericTypeTemplate candidate generator) binderP binderT doc, [])
-genericSumtypeCopy :: [String] -> Ty -> [SumtypeCase] -> (String, Binder)
+          else instanceBinderWithDeps binderP binderT (TG.generateConcreteTypeTemplate candidate generator) doc
-genericSumtypeCopy pathStrings originalStructTy cases =
-  defineTypeParameterizedTemplate templateCreator path (FuncTy [RefTy originalStructTy (VarTy "q")] originalStructTy StaticLifetimeTy) docs
   where
-    path = SymPath pathStrings "copy"
+    generator :: TG.TemplateGenerator TC.TypeCandidate
-    t = FuncTy [RefTy (VarTy "p") (VarTy "q")] (VarTy "p") StaticLifetimeTy
+    generator = TG.mkTemplateGenerator genT decl body deps
-    docs = "copies a `" ++ show originalStructTy ++ "`."
-    templateCreator = TemplateCreator $
-      \typeEnv env ->
-        Template
-          t
-          (const (toTemplate "$p $NAME($p* pRef)"))
-          ( \(FuncTy [RefTy concreteStructTy _] _ _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-               in tokensForSumtypeCopy typeEnv env concreteStructTy correctedCases
-          )
-          ( \(FuncTy [RefTy concreteStructTy _] _ _) ->
-              let mappings = unifySignatures originalStructTy concreteStructTy
-                  correctedCases = replaceGenericTypesOnCases mappings cases
-               in if isTypeGeneric concreteStructTy
-                    then []
-                    else
-                      concatMap
-                        (depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
-                        (filter (isManaged typeEnv env) (concatMap caseTys correctedCases))
-          )
 
--- | The template for the 'copy' function of a concrete sumtype
+    genT :: TG.TypeGenerator TC.TypeCandidate
-concreteSumtypeCopy :: [String] -> TypeEnv -> Env -> Ty -> [SumtypeCase] -> ((String, Binder), [XObj])
+    genT _ = FuncTy [RefTy (VarTy "p") (VarTy "q")] (VarTy "p") StaticLifetimeTy
-concreteSumtypeCopy insidePath typeEnv env structTy@(StructTy (ConcreteNameTy _) _) cases =
-  instanceBinderWithDeps (SymPath insidePath "copy") (FuncTy [RefTy structTy (VarTy "q")] structTy StaticLifetimeTy) template doc
-  where
-    doc = "copies a `" ++ (show structTy) ++ "`."
-    template =
-      Template
-        (FuncTy [RefTy (VarTy "p") (VarTy "q")] (VarTy "p") StaticLifetimeTy)
-        (const (toTemplate "$p $NAME($p* pRef)"))
-        (const (tokensForSumtypeCopy typeEnv env structTy cases))
-        ( \_ ->
-            concatMap
-              (depsOfPolymorphicFunction typeEnv env [] "copy" . typesCopyFunctionType)
-              (filter (isManaged typeEnv env) (concatMap caseTys cases))
-        )
-concreteSumtypeCopy _ _ _ _ _ = error "concretesumtypecopy"
 
-tokensForSumtypeCopy :: TypeEnv -> Env -> Ty -> [SumtypeCase] -> [Token]
+    decl :: TG.TokenGenerator TC.TypeCandidate
-tokensForSumtypeCopy typeEnv env concreteStructTy cases =
+    decl _ = toTemplate "$p $NAME($p* pRef)"
-  toTemplate $
-    unlines
-      [ "$DECL {",
-        "    $p copy = *pRef;",
-        joinLines $
-          zipWith
-            (curry (copyCase typeEnv env concreteStructTy))
-            cases
-            (True : repeat False),
-        "    return copy;",
-        "}"
-      ]
 
-copyCase :: TypeEnv -> Env -> Ty -> (SumtypeCase, Bool) -> String
+    body :: TG.TokenGenerator TC.TypeCandidate
-copyCase typeEnv env concreteStructTy@(StructTy _ _) (theCase, isFirstCase) =
+    body GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [RefTy ty _] _ _), value} =
-  let (name, tys, correctedTagName) = namesFromCase theCase concreteStructTy
+      tokensForSumtypeCopy tenv env originalT ty (TC.getFields value)
-   in unlines
+    body _ = toTemplate "/* template error! */"
-        [ "    " ++ (if isFirstCase then "" else "else ") ++ "if(pRef->_tag == " ++ correctedTagName ++ ") {",
+
-          joinLines $ memberCopy typeEnv env <$> unionMembers name tys,
+    deps :: TG.DepenGenerator TC.TypeCandidate
-          "    }"
+    deps GeneratorArg{tenv, env, originalT, instanceT=(FuncTy [RefTy ty _] _ _), value} =
+      depsForCopy tenv env originalT ty (TC.getFields value)
+    deps _ = []
+
+-------------------------------------------------------------------------------
+-- Token and dep generators
+
+type TokenGen = TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [Token]
+type DepGen   = TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [XObj]
+
+--------------------------------------------------------------------------------
+-- Initializers
+
+-- | Generate an init function declaration.
+tokensForCaseInitDecl :: Ty -> Ty -> TC.TypeField -> [Token]
+tokensForCaseInitDecl orig concrete@(StructTy (ConcreteNameTy _) _) (TC.SumField _ tys) =
+  let mappings    = unifySignatures orig concrete
+      concreteTys = map (replaceTyVars mappings) tys
+   in toTemplate ("$p $NAME(" ++ joinWithComma (zipWith (curry memberArg) anonMemberNames (remove isUnit concreteTys)) ++ ")")
+tokensForCaseInitDecl _ _ _ =
+  error "tokensForCaseInitDecl"
+
+-- | Given an allocation mode, an original, possibly polymorphic type, a
+-- concrete type and a sum type field, generate an init function body.
+tokensForCaseInit :: AllocationMode -> Ty -> Ty -> TC.TypeField -> [Token]
+tokensForCaseInit alloc orig concrete (TC.SumField fieldname tys) =
+  let mappings    = unifySignatures orig concrete
+      concreteTys = map (replaceTyVars mappings) tys
+      unitless = zip anonMemberNames $ remove isUnit concreteTys
+   in multilineTemplate
+          [ "$DECL {",
+            allocate alloc,
+            joinLines (assign alloc fieldname . fst <$> unitless),
+            "    instance._tag = " ++ tagName concrete fieldname ++ ";",
+            "    return instance;",
+            "}"
+          ]
+   where allocate :: AllocationMode -> String
+         allocate StackAlloc = "  $p instance;"
+         allocate HeapAlloc = "  $p instance = CARP_MALLOC(sizeof(" ++ show concrete ++ "));"
+
+         assign :: AllocationMode -> String -> String -> String
+         assign alloc' name member =
+           "    instance" ++ (accessor alloc') ++ "u." ++ name ++ "." ++ member ++ " = " ++ member ++ ";"
+tokensForCaseInit _ _ _ _ = error "tokenForCaseInit"
+
+accessor :: AllocationMode -> String
+accessor StackAlloc = "."
+accessor HeapAlloc = "->"
+
+--------------------------------------------------------------------------------
+-- Copy
+
+-- | Generates dependencies for sum type copy functions.
+depsForCopy :: DepGen
+depsForCopy tenv env generic concrete fields =
+  let mappings = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+   in if isTypeGeneric concrete
+        then []
+        else
+          concatMap
+            (depsOfPolymorphicFunction tenv env [] "copy" . typesCopyFunctionType)
+            (filter (isManaged tenv env) (concatMap TC.fieldTypes concreteFields))
+
+-- | Generates C function bodies for sum type copy functions.
+tokensForSumtypeCopy :: TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [Token]
+tokensForSumtypeCopy typeEnv env generic concrete fields =
+  let mappings = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+   in multilineTemplate
+        [ "$DECL {",
+          "    $p copy = *pRef;",
+          joinLines $
+            zipWith
+              (curry copyCase)
+              concreteFields
+              (True : repeat False),
+          "    return copy;",
+          "}"
         ]
-copyCase _ _ _ _ = error "copycase"
+  where
+    copyCase :: (TC.TypeField, Bool) -> String
+    copyCase (theCase, isFirstCase) =
+      let (name, tys, correctedTagName) = namesFromCase theCase concrete
+       in unlines
+            [ "    " ++ (if isFirstCase then "" else "else ") ++ "if(pRef->_tag == " ++ correctedTagName ++ ") {",
+              joinLines $ memberCopy typeEnv env <$> unionMembers name tys,
+              "    }"
+            ]
+
+--------------------------------------------------------------------------------
+-- Delete
+
+-- | Generates tokens for the C function body of sum type copy functions.
+tokensForDeleteBody :: TokenGen
+tokensForDeleteBody tenv env generic concrete fields =
+  let mappings = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+   in multilineTemplate [
+        "$DECL {",
+        concatMap deleteCase (zip concreteFields (True : repeat False)),
+        "}"
+     ]
+  where deleteCase :: (TC.TypeField, Bool) -> String
+        deleteCase (theCase, isFirstCase) =
+          let (name, tys, correctedTagName) = namesFromCase theCase concrete
+           in unlines
+                [ "  " ++ (if isFirstCase then "" else "else ") ++ "if(p._tag == " ++ correctedTagName ++ ") {",
+                  joinLines $ memberDeletion tenv env <$> unionMembers name tys,
+                  "  }"
+                ]
+
+-- | Generates deps for the body of a delete function.
+depsForDelete :: TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [XObj]
+depsForDelete tenv env generic concrete fields =
+  let mappings       = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+   in if isTypeGeneric concrete
+        then []
+        else concatMap
+               (depsOfPolymorphicFunction tenv env [] "delete" . typesDeleterFunctionType)
+               (filter (isManaged tenv env) (concatMap (TC.fieldTypes) concreteFields))
+
+--------------------------------------------------------------------------------
+-- Str and prn
+
+-- | Fetches dependencies for str and prn functions.
+depsForStr :: TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [XObj]
+depsForStr tenv env generic concrete fields =
+  let ft = FuncTy [RefTy concrete (VarTy "q")] StringTy StaticLifetimeTy
+      mappings = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+      tys = remove isFullyGenericType (concatMap TC.fieldTypes concreteFields)
+   in (concatMap (depsOfPolymorphicFunction tenv env [] "prn" . typesStrFunctionType tenv env) tys)
+        ++ [defineFunctionTypeAlias ft | not (isTypeGeneric concrete)]
+
+-- | Generates C function body tokens for sum type str and prn functions.
+tokensForStr :: TypeEnv -> Env -> Ty -> Ty -> [TC.TypeField] -> [Token]
+tokensForStr typeEnv env generic concrete fields =
+  let mappings = unifySignatures generic concrete
+      concreteFields = replaceGenericTypesOnCases mappings fields
+   in multilineTemplate
+        [ "$DECL {",
+          "  // convert members to String here:",
+          "  String temp = NULL;",
+          "  int tempsize = 0;",
+          "  (void)tempsize; // that way we remove the occasional unused warning ",
+          calculateStructStrSize concreteFields,
+          "  String buffer = CARP_MALLOC(size);",
+          "  String bufferPtr = buffer;",
+          "",
+          concatMap strCase concreteFields,
+          "  return buffer;",
+          "}"
+        ]
+  where strCase :: TC.TypeField -> String
+        strCase theCase =
+          let (name, tys, correctedTagName) = namesFromCase theCase concrete
+           in unlines
+                [ "  if(p->_tag == " ++ correctedTagName ++ ") {",
+                  "    sprintf(bufferPtr, \"(%s \", \"" ++ name ++ "\");",
+                  "    bufferPtr += strlen(\"" ++ name ++ "\") + 2;\n",
+                  joinLines $ memberPrn typeEnv env <$> unionMembers name tys,
+                  "    bufferPtr--;",
+                  "    sprintf(bufferPtr, \")\");",
+                  "  }"
+                ]
+
+        -- | Figure out how big the string needed for the string representation of the struct has to be.
+        calculateStructStrSize :: [TC.TypeField] -> String
+        calculateStructStrSize cases = "  int size = 1;\n" ++ concatMap strSizeCase cases
+
+        strSizeCase :: TC.TypeField -> String
+        strSizeCase theCase =
+          let (name, tys, correctedTagName) = namesFromCase theCase concrete
+           in unlines
+                [ "  if(p->_tag == " ++ correctedTagName ++ ") {",
+                  "    size += snprintf(NULL, 0, \"(%s \", \"" ++ name ++ "\");",
+                  joinLines $ memberPrnSize typeEnv env <$> unionMembers name tys,
+                  "  }"
+                ]
+
+--------------------------------------------------------------------------------
+-- Additional utilities
+
+namesFromCase :: TC.TypeField -> Ty -> (String, [Ty], String)
+namesFromCase theCase concreteStructTy =
+  let name = TC.fieldName theCase
+   in (name, TC.fieldTypes (TC.SumField (TC.fieldName theCase) (remove isUnit (TC.fieldTypes theCase))), tagName concreteStructTy name)
 
 anonMemberName :: String -> String -> String
 anonMemberName name anon = "u." ++ name ++ "." ++ anon

src/TemplateGenerator.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module TemplateGenerator where
+
+import Obj
+import Types
+import qualified TypeCandidate as TC
+
+--------------------------------------------------------------------------------
+-- Template Generators
+--
+-- Template generators define a standardized way to construct templates given a fixed set of arguments.
+
+-- | GeneratorArg is an argument to a template generator.
+data GeneratorArg a = GeneratorArg {
+  tenv      :: TypeEnv,
+  env       :: Env,
+  originalT :: Ty,
+  instanceT :: Ty,
+  value     :: a
+}
+
+type TypeGenerator a  = GeneratorArg a -> Ty
+type TokenGenerator a = GeneratorArg a -> [Token]
+type DepenGenerator a = GeneratorArg a -> [XObj]
+
+data TemplateGenerator a = TemplateGenerator {
+  genT :: TypeGenerator a,
+  decl :: TokenGenerator a,
+  body :: TokenGenerator a,
+  deps :: DepenGenerator a
+}
+
+mkTemplateGenerator :: TypeGenerator a -> TokenGenerator a -> TokenGenerator a -> DepenGenerator a -> TemplateGenerator a
+mkTemplateGenerator f g h j = TemplateGenerator f g h j
+
+generateConcreteTypeTemplate :: TC.TypeCandidate -> TemplateGenerator TC.TypeCandidate -> Template
+generateConcreteTypeTemplate candidate gen =
+  let arg = GeneratorArg
+              (TC.getTypeEnv candidate)
+              (TC.getValueEnv candidate)
+              (TC.toType candidate)
+              (TC.toType candidate)
+              candidate
+      t = (genT gen) $ arg
+      d = (\tt -> (decl gen) $ (arg {instanceT = tt}))
+      b = (\tt -> (body gen) $ (arg {instanceT = tt}))
+      p = (\tt -> (deps gen) $ (arg {instanceT = tt}))
+   in Template t d b p
+
+generateConcreteFieldTemplate :: TC.TypeCandidate -> TC.TypeField -> TemplateGenerator TC.TypeField -> Template
+generateConcreteFieldTemplate candidate field gen =
+  let arg = GeneratorArg
+              (TC.getTypeEnv candidate)
+              (TC.getValueEnv candidate)
+              (TC.toType candidate)
+              (TC.toType candidate)
+              field
+      t = (genT gen) $ arg
+      d = (\tt -> (decl gen) $ (arg {instanceT = tt}))
+      b = (\tt -> (body gen) $ (arg {instanceT = tt}))
+      p = (\tt -> (deps gen) $ (arg {instanceT = tt}))
+   in Template t d b p
+
+generateGenericFieldTemplate :: TC.TypeCandidate -> TC.TypeField -> TemplateGenerator TC.TypeField -> TemplateCreator
+generateGenericFieldTemplate candidate field gen =
+  let arg = GeneratorArg
+              (TC.getTypeEnv candidate)
+              (TC.getValueEnv candidate)
+              (TC.toType candidate)
+              (TC.toType candidate)
+              field
+      t = (genT gen) arg
+   in TemplateCreator $
+        \tenv env ->
+          Template
+            t
+            (\tt -> (decl gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))
+            (\tt -> (body gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))
+            (\tt -> (deps gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))
+
+generateGenericTypeTemplate :: TC.TypeCandidate -> TemplateGenerator TC.TypeCandidate -> TemplateCreator
+generateGenericTypeTemplate candidate gen =
+  let arg = GeneratorArg
+              (TC.getTypeEnv candidate)
+              (TC.getValueEnv candidate)
+              (TC.toType candidate)
+              (TC.toType candidate)
+              candidate
+      t = (genT gen) arg
+   in TemplateCreator $
+        \tenv env ->
+          Template
+            t
+            (\tt -> (decl gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))
+            (\tt -> (body gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))
+            (\tt -> (deps gen) $ (arg {instanceT = tt, tenv = tenv, env = env}))

src/TypeCandidate.hs

@@ -0,0 +1,174 @@
+-- | Module type candidate defines a structure for type definitions that have not been validated.
+--
+-- Type candidates can either be valid or invalid. Invalid type candidates will be rejected by the type system.
+module TypeCandidate
+  (mkStructCandidate,
+   mkSumtypeCandidate,
+   TypeVarRestriction(..),
+   InterfaceConstraint(..),
+   TypeField(..),
+   TypeMode(..),
+   getFields,
+   TypeCandidate.getName,
+   getRestriction,
+   getVariables,
+   TypeCandidate.getTypeEnv,
+   getConstraints,
+   getValueEnv,
+   getMode,
+   TypeCandidate.getPath,
+   getFullPath,
+   fieldName,
+   fieldTypes,
+   setRestriction,
+   toType,
+   TypeCandidate,
+  )
+where
+
+import Types
+import TypeError
+import Obj
+import Util
+
+--------------------------------------------------------------------------------
+-- Data
+
+data TypeVarRestriction
+  = AllowAny
+  | OnlyNamesInScope
+  deriving Eq
+
+data InterfaceConstraint = InterfaceConstraint {
+  name  :: String,
+  types :: Ty
+} deriving Show
+
+data TypeField
+  = StructField String Ty
+  | SumField String [Ty]
+  deriving (Eq, Show)
+
+data TypeMode
+  = Struct
+  | Sum
+  deriving (Eq, Show)
+
+data TypeCandidate = TypeCandidate {
+  typeName    :: String,
+  variables   :: [Ty],
+  members     :: [TypeField],
+  restriction :: TypeVarRestriction,
+  constraints :: [InterfaceConstraint],
+  typeEnv     :: TypeEnv,
+  valueEnv    :: Env,
+  mode        :: TypeMode,
+  path        :: [String]
+}
+
+--------------------------------------------------------------------------------
+-- Private
+
+-- | Set the member fields of a type candidate.
+setMembers :: TypeCandidate -> [TypeField] -> TypeCandidate
+setMembers candidate fields = candidate {members = fields}
+
+-- | Given a pair of XObjs, construct a struct (product type) field.
+mkStructField :: (XObj, XObj) -> Either TypeError TypeField
+mkStructField ((XObj (Sym (SymPath [] fname) _) _ _), tx) =
+  maybe (Left (NotAType tx)) (Right . StructField fname) (xobjToTy tx)
+mkStructField (x, _) = Left (InvalidStructField x)
+
+-- | Given an XObj, construct a sum type field.
+mkSumField :: XObj -> Either TypeError TypeField
+mkSumField x@(XObj (Lst [XObj (Sym (SymPath [] fname) Symbol) _ _, XObj (Arr txs) _ _]) _ _) =
+  maybe (Left (InvalidSumtypeCase x)) (Right . SumField fname) (mapM xobjToTy txs)
+mkSumField (XObj (Sym (SymPath [] fname) Symbol) _ _) = Right (SumField fname [])
+mkSumField x = Left (InvalidSumtypeCase x)
+
+--------------------------------------------------------------------------------
+-- Public
+
+-- | Returns the fields of a type candidate
+getFields :: TypeCandidate -> [TypeField]
+getFields = members
+
+getName :: TypeCandidate -> String
+getName = typeName
+
+getVariables :: TypeCandidate -> [Ty]
+getVariables = variables
+
+getRestriction :: TypeCandidate -> TypeVarRestriction
+getRestriction = restriction
+
+setRestriction :: TypeCandidate -> TypeVarRestriction -> TypeCandidate
+setRestriction candidate restrict = candidate {restriction = restrict}
+
+getTypeEnv :: TypeCandidate -> TypeEnv
+getTypeEnv = typeEnv
+
+getValueEnv :: TypeCandidate -> Env
+getValueEnv = valueEnv
+
+getConstraints :: TypeCandidate -> [InterfaceConstraint]
+getConstraints = constraints
+
+getMode :: TypeCandidate -> TypeMode
+getMode = mode
+
+getPath :: TypeCandidate -> [String]
+getPath = path
+
+getFullPath :: TypeCandidate -> [String]
+getFullPath candidate = TypeCandidate.getPath candidate ++ [TypeCandidate.getName candidate]
+
+-- | Returns the name of a type field.
+fieldName :: TypeField -> String
+fieldName (StructField n _) = n
+fieldName (SumField n _) = n
+
+-- | Returns the types of a type field.
+fieldTypes :: TypeField -> [Ty]
+fieldTypes (StructField _ ty) = [ty]
+fieldTypes (SumField _ ts) = ts
+
+-- | Creates a struct type candidate.
+mkStructCandidate :: String -> [Ty] -> TypeEnv -> Env -> [XObj] -> [String] -> Either TypeError TypeCandidate
+mkStructCandidate tname vars tenv env memberxs ps =
+  let typedMembers = mapM mkStructField (pairwise memberxs)
+      candidate = TypeCandidate {
+                    typeName = tname,
+                    variables = vars,
+                    members = [],
+                    restriction = OnlyNamesInScope,
+                    constraints = [],
+                    typeEnv = tenv,
+                    valueEnv = env,
+                    mode = Struct,
+                    path = ps
+                  }
+   in if even (length memberxs)
+        then fmap (setMembers candidate) typedMembers
+        else Left (UnevenMembers memberxs)
+
+-- | Creates a sum type candidate.
+mkSumtypeCandidate :: String -> [Ty] -> TypeEnv -> Env -> [XObj] -> [String] -> Either TypeError TypeCandidate
+mkSumtypeCandidate tname vars tenv env memberxs ps =
+  let typedMembers = mapM mkSumField memberxs
+      candidate = TypeCandidate {
+                    typeName = tname,
+                    variables = vars,
+                    members = [],
+                    restriction = OnlyNamesInScope,
+                    constraints = [],
+                    typeEnv = tenv,
+                    valueEnv = env,
+                    mode = Sum,
+                    path = ps
+                  }
+   in fmap (setMembers candidate) typedMembers
+
+toType :: TypeCandidate -> Ty
+toType candidate =
+  StructTy (ConcreteNameTy (SymPath (TypeCandidate.getPath candidate) (TypeCandidate.getName candidate))) (getVariables candidate)

src/TypeError.hs

@@ -62,6 +62,7 @@ data TypeError
   | InconsistentKinds String [XObj]
   | FailedToAddLambdaStructToTyEnv SymPath XObj
   | FailedToInstantiateGenericType Ty
+  | InvalidStructField XObj
 
 instance Show TypeError where
   show (SymbolMissingType xobj env) =
@@ -279,6 +280,10 @@ instance Show TypeError where
     "I failed to read `" ++ pretty xobj ++ "` as a sumtype case at "
       ++ prettyInfoFromXObj xobj
       ++ ".\n\nSumtype cases look like this: `(Foo [Int typevar])`"
+  show (InvalidStructField xobj) =
+    "I can't use " ++ pretty xobj ++ "as a struct field at "
+      ++ prettyInfoFromXObj xobj
+      ++ ".\n\nStruct fields look like this: x Int, e.g. (deftype Point [x Int y Int])"
   show (InvalidMemberType t xobj) =
     "I can’t use the type `" ++ show t ++ "` as a member type at "
       ++ prettyInfoFromXObj xobj

src/Validate.hs

@@ -1,77 +1,58 @@
 module Validate where
 
 import Control.Monad (foldM)
-import Data.Function (on)
 import Data.List (nubBy, (\\))
-import Data.Maybe (fromJust)
 import qualified Env as E
 import Obj
 import TypeError
 import TypePredicates
 import Types
-import Util
+import qualified TypeCandidate as TC
+import qualified Reify as R
 
-{-# ANN validateMemberCases "HLint: ignore Eta reduce" #-}
+--------------------------------------------------------------------------------
+-- Public
 
-data TypeVarRestriction
+-- | Determine whether a given type candidate is a valid type.
-  = AllowAnyTypeVariableNames -- Used when checking a type found in the code, e.g. (Foo a), any name is OK for 'a'
+validateType :: TC.TypeCandidate -> Either TypeError ()
-  | AllowOnlyNamesInScope -- Used when checking a type definition, e.g. (deftype (Foo a) [x a]), requires a to be in scope
+validateType candidate =
-  deriving (Eq)
+  do checkDuplicateMembers candidate
+     checkMembers candidate
+     checkKindConsistency candidate
 
--- | Make sure that the member declarations in a type definition
+--------------------------------------------------------------------------------
--- | Follow the pattern [<name> <type>, <name> <type>, ...]
+-- Private
--- | TODO: This function is only called by the deftype parts of the codebase, which is more specific than the following check implies.
-validateMemberCases :: TypeEnv -> Env -> [Ty] -> [XObj] -> Either TypeError ()
-validateMemberCases typeEnv globalEnv typeVariables rest = mapM_ visit rest
-  where
-    visit (XObj (Arr membersXObjs) _ _) =
-      validateMembers AllowOnlyNamesInScope typeEnv globalEnv typeVariables membersXObjs
-    visit xobj =
-      Left (InvalidSumtypeCase xobj)
 
-validateMembers :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> [XObj] -> Either TypeError ()
+-- | Checks whether any field names in the type are used more than once.
-validateMembers typeVarRestriction typeEnv globalEnv typeVariables membersXObjs =
+checkDuplicateMembers :: TC.TypeCandidate -> Either TypeError ()
-  checkUnevenMembers >> checkDuplicateMembers >> checkMembers >> checkKindConsistency
+checkDuplicateMembers candidate =
-  where
+  let allFields = fmap TC.fieldName (TC.getFields candidate)
-    pairs = pairwise membersXObjs
+      uniqueFields = nubBy (==) allFields
-    -- Are the number of members even?
+      duplicates = allFields \\ uniqueFields
-    checkUnevenMembers :: Either TypeError ()
+   in if null duplicates
-    checkUnevenMembers =
-      if even (length membersXObjs)
         then Right ()
-        else Left (UnevenMembers membersXObjs)
+        else Left (DuplicatedMembers (map R.symbol duplicates))
-    -- Are any members duplicated?
+
-    checkDuplicateMembers :: Either TypeError ()
+-- | Returns an error if one of the types fields can't be used as a member type.
-    checkDuplicateMembers =
+checkMembers :: TC.TypeCandidate -> Either TypeError ()
-      if length fields == length uniqueFields
+checkMembers candidate =
-        then Right ()
+  let  tenv = TC.getTypeEnv candidate
-        else Left (DuplicatedMembers dups)
+       env  = TC.getValueEnv candidate
-      where
+       tys  = concat (map TC.fieldTypes (TC.getFields candidate))
-        fields = fst <$> pairs
+     in mapM_ (canBeUsedAsMemberType (TC.getName candidate) (TC.getRestriction candidate) tenv env (TC.getVariables candidate)) tys
-        uniqueFields = nubBy ((==) `on` xobjObj) fields
+
-        dups = fields \\ uniqueFields
+-- | Returns an error if the type variables in the body of the type and variables in the head of the type are of incompatible kinds.
-    -- Do all type variables have consistent kinds?
+checkKindConsistency :: TC.TypeCandidate -> Either TypeError ()
-    checkKindConsistency :: Either TypeError ()
+checkKindConsistency candidate =
-    checkKindConsistency =
+  let allFieldTypes = concat (map TC.fieldTypes (TC.getFields candidate))
-      case areKindsConsistent varsOnly of
+      allGenerics   = filter isTypeGeneric $ allFieldTypes
-        Left var -> Left (InconsistentKinds var membersXObjs)
+   in case areKindsConsistent allGenerics of
+        Left var -> Left (InconsistentKinds var (map R.reify allFieldTypes))
         _ -> pure ()
-      where
-        -- fromJust is safe here; invalid types will be caught in the prior check.
-        -- todo? be safer anyway?
-        varsOnly = filter isTypeGeneric (map (fromJust . xobjToTy . snd) pairs)
-    checkMembers :: Either TypeError ()
-    checkMembers = mapM_ (okXObjForType typeVarRestriction typeEnv globalEnv typeVariables . snd) pairs
-
-okXObjForType :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> XObj -> Either TypeError ()
-okXObjForType typeVarRestriction typeEnv globalEnv typeVariables xobj =
-  case xobjToTy xobj of
-    Just t -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables t xobj
-    Nothing -> Left (NotAType xobj)
 
 -- | Can this type be used as a member for a deftype?
-canBeUsedAsMemberType :: TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> Ty -> XObj -> Either TypeError ()
+canBeUsedAsMemberType :: String -> TC.TypeVarRestriction -> TypeEnv -> Env -> [Ty] -> Ty -> Either TypeError ()
-canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables ty xobj =
+canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables ty =
   case ty of
     UnitTy -> pure ()
     IntTy -> pure ()
@@ -86,8 +67,7 @@ canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables ty xobj
     FuncTy {} -> pure ()
     PointerTy UnitTy -> pure ()
     PointerTy inner ->
-      canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables inner xobj
+      canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables inner
-        >> pure ()
     -- Struct variables may appear as complete applications or individual
     -- components in the head of a definition; that is the forms:
     --     ((Foo (f a b)) [x (f a b)])
@@ -108,41 +88,39 @@ canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables ty xobj
     struct@(StructTy name tyVars) ->
       checkVar struct <> checkStruct name tyVars
     v@(VarTy _) -> checkVar v
-    _ -> Left (InvalidMemberType ty xobj)
+    _ -> Left (InvalidMemberType ty (R.reify ty))
   where
     checkStruct :: Ty -> [Ty] -> Either TypeError ()
     checkStruct (ConcreteNameTy (SymPath [] "Array")) [innerType] =
-      canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables innerType xobj
+      canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables innerType
-        >> pure ()
     checkStruct (ConcreteNameTy path@(SymPath _ name)) vars =
       case E.getTypeBinder typeEnv name <> E.findTypeBinder globalEnv path of
         Right (Binder _ (XObj (Lst (XObj (ExternalType _) _ _ : _)) _ _)) ->
           pure ()
         Right (Binder _ (XObj (Lst (XObj (Deftype t) _ _ : _)) _ _)) ->
-          checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
+          checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables typ) () vars
         Right (Binder _ (XObj (Lst (XObj (DefSumtype t) _ _ : _)) _ _)) ->
-          checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
+          checkInhabitants t >> foldM (\_ typ -> canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables typ) () vars
-        _ -> Left (NotAmongRegisteredTypes ty xobj)
+        _ -> Left (NotAmongRegisteredTypes ty (R.reify ty))
       where
         checkInhabitants :: Ty -> Either TypeError ()
         checkInhabitants (StructTy _ vs) =
           if length vs == length vars
             then pure ()
-            else Left (UninhabitedConstructor ty xobj (length vs) (length vars))
+            else Left (UninhabitedConstructor ty (R.reify ty) (length vs) (length vars))
-        checkInhabitants _ = Left (InvalidMemberType ty xobj)
+        checkInhabitants _ = Left (InvalidMemberType ty (R.reify ty))
     checkStruct v@(VarTy _) vars =
-      canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables v xobj
+      canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables v
-        >> foldM (\_ typ -> canBeUsedAsMemberType typeVarRestriction typeEnv globalEnv typeVariables typ xobj) () vars
+        >> foldM (\_ typ -> canBeUsedAsMemberType tname typeVarRestriction typeEnv globalEnv typeVariables typ) () vars
     checkStruct _ _ = error "checkstruct"
     checkVar :: Ty -> Either TypeError ()
     checkVar variable =
       case typeVarRestriction of
-        AllowAnyTypeVariableNames ->
+        TC.AllowAny -> pure ()
-          pure ()
+        TC.OnlyNamesInScope ->
-        AllowOnlyNamesInScope ->
           if any (isCaptured variable) typeVariables
             then pure ()
-            else Left (InvalidMemberType ty xobj)
+            else Left (InvalidMemberType ty (R.reify ty))
       where
         -- If a variable `a` appears in a higher-order polymorphic form, such as `(f a)`
         -- `a` may be used as a member, sans `f`, but `f` may not appear

test/output/test/test-for-errors/deftype_type_var_not_in_scope.carp.output.expected

@@ -1 +1 @@
-deftype_type_var_not_in_scope.carp:3:10 deftype_type_var_not_in_scope.carp:3:21 Can't use 'b' as a type for a member variable.
+deftype_type_var_not_in_scope.carp:3:10  Can't use 'b' as a type for a member variable.

test/output/test/test-for-errors/sumtype_type_var_not_in_scope.carp.output.expected

@@ -1 +1 @@
-sumtype_type_var_not_in_scope.carp:3:10 sumtype_type_var_not_in_scope.carp:4:3 Can't use 'x' as a type for a member variable.
+sumtype_type_var_not_in_scope.carp:3:10  Can't use 'x' as a type for a member variable.