From f07dd88f1fa3fab0db06c92e9d80d68fdffb2493 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sat, 20 Jan 2024 11:29:23 -0500
Subject: [PATCH 01/14] Begin dev cycle 0.44

In this dev cycle I want to add very basic support for typeclasses. I
will allow type classes to be defined, which will offer parametric
polymorphism, but I will not add a constraint system.

The most pressing use case of this is for serialization. Currently I do
this:

```
packMap :: pack => [(a,b)] -> Map a b
```

Here the `pack` is a special term the states, in essense, that this
function is specializing some generic function `pack :: a -> b`. But
this is a rather odd syntax. A function can only specialize one
function, so presumably I can't use multiple such constraints, and
should I raise an error if someone tries? Worse, I can't cleanly couple
multiple functions that go together in a typeclass. In this case, the
`pack` and the `unpack` instances are separate and I have to unify them
with (rather tedious) outside code later.

With typeclass syntax I can do:

```
class Packable a b where
    pack :: a -> b
    unpack :: b -> a

instance Packable [(a,b)] (Map a b) where
    source Cpp from "map.hpp" ("pack", "unpack")
    source Py from "map.py" ("pack", "unpack")
```

There are a few strong limitations I am going to place on the typeclass
system for now.

First, only source statements are allowed in instances. The functions
written in typeclasses will tend to be very basal functions.  In
Haskell, additional functions are often defined inside the typeclass.
This is useful, but not necessary. I can define these functions outside.

Second, typeclasses may not be used as constraints. This is simply
because I am lazy. Adding typeclass constraints to signatures does
improve readability, at times, but it requires additional checking of
things that can be inferred. I will add it later. In fact, I already
support it syntactically, so knock yourself out.

Third, typeclasses and instances are global. This is purely laziness on
my part. But my scoping system is currently borked and needs to a total
rewrite, and I don't have the time. Transitioning to scoped in the
future will require a bit of finagling with the import/export statements
-- nothing radical. Further, it is probably best practices to not have
different typeclass instances existing in the same program anyways.
Making typeclasses and instances global also is a solution to the orphan
instance problem (though an admittedly an ugly one).

```
class Arithemtic a where
    add :: a -> a -> a
    sub :: a -> a -> a
    mul :: a -> a -> a

class Zero a where
    zero :: a

instance Zero Int where
    ...

instance Zero Real where
    ...

instance Arithmetic Int where
    ...

instance Arithmetic Real where
    ...

foo :: [Int] -> [Int]
foo = foldr add zero
```

When the typechecker encounters a symbol, it will look up a type
signature for it. If it is term defined in a typeclass, the returned
type will be generic (usually, or at least it will be whatever was
defined in the `class` block). The types must be inferrable from the
context without considering the instance data. Technically, it will
sometimes be possible to infer the instance by ruling all but one out,
but I will not yet do this.

The instances will be used when need to look up sources. Then we will
search by the function name and the value of the class parameters. For
example, for `pack` we look up the types `[(a,b)]` and `Map a b` among
the instances `Packable`. Now, these will be fully inferred, so we will
need to search by subtyping.

I more or less already have a typeclass system for the special case of
(un)packers.

I may also need to create a Prelude with typeclass definitions to
provide some rigidity to the system. At very least, the Packable
typeclass needs a definition as do future internal typeclasses.
---
 vim-syntax/loc.vim | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/vim-syntax/loc.vim b/vim-syntax/loc.vim
index 1374d48c..604ed9ed 100644
--- a/vim-syntax/loc.vim
+++ b/vim-syntax/loc.vim
@@ -127,6 +127,8 @@ syn match s_error '^#'
 syn match reserved '^table'
 syn match reserved '^import'
 syn match reserved '^type'
+syn match reserved '^instance'
+syn match reserved '^class'
 syn match reserved '^object'
 syn match reserved '^record'
 

From 6d93b070dba9b7e5537a6c2f257737d20d887e45 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sat, 20 Jan 2024 21:48:14 -0500
Subject: [PATCH 02/14] (1/408 fail) Add first test of typeclasses

The goal here is to test a basic typeclass for addition. Once this test
passes, I will need to consider how to systematically test typeclasses
and typeclass inheritance. I want to have the basics worked out before I
replace the packing system.

And I am already reconsidering my second limitation from the last commit
that I will not put constraints in signatures. Perhaps I should. They
are not too much of a bother, I think. First I resolve generic types.
Then I pass through gamma and assert that instances exist for all
specified constraints for each resolved generic type. There is a little
more to this. Since I should also raise an error when a function is
lacking a constraint that it should have. For example:

```
fromList :: Ord k => [(k,v)] -> Map k v

singleton :: k -> v -> Map k v
singleton k v = fromList [(k,v)]
```

Here `singleton` is mis-typed since the `Ord` constraint in `fromList` is not
satisfied.

I also need to infer constraints. All this typechecking will be done
entirely in the frontend. I need to store somewhere a map between
typeclass and function name. Something of type:

```
Map EVar Typeclass -- if we are going with globals
GMap Int MVar (Map EVar Typeclass) -- if we not going global
```

Looking up instances can be done in the backend when I handle
language-specific code. Currently sources are looked up by index in the
MorlocState.stateSources object of type:

```
GMap Int MVar [Source]
```

This won't work for the typelcass members. I would need to look up
sources by name and type. Something like this (assuming global):

```
Map EVar [([TypeU], Source)]
```

I need to support multi-parameter typeclasses and overlapping instances.
The `Packable` typeclass has two parameters and there likely will be
specialized packers optimized for specific types, so I need to find the
instance with the most specific type.
---
 test-suite/Main.hs                            |  2 ++
 .../golden-tests/typeclasses-1/Makefile       |  8 +++++
 test-suite/golden-tests/typeclasses-1/exp.txt |  2 ++
 .../golden-tests/typeclasses-1/main.loc       | 29 +++++++++++++++++++
 4 files changed, 41 insertions(+)
 create mode 100644 test-suite/golden-tests/typeclasses-1/Makefile
 create mode 100644 test-suite/golden-tests/typeclasses-1/exp.txt
 create mode 100644 test-suite/golden-tests/typeclasses-1/main.loc

diff --git a/test-suite/Main.hs b/test-suite/Main.hs
index 9e8e12c4..2bfa4159 100644
--- a/test-suite/Main.hs
+++ b/test-suite/Main.hs
@@ -23,6 +23,8 @@ main = do
       , substituteTVarTests
       , subtypeTests
 
+      , golden "typeclasses-1" "typeclasses-1"
+
       , golden "string-encoding" "string-encoding"
 
       , golden "file-input-py" "file-input-py"
diff --git a/test-suite/golden-tests/typeclasses-1/Makefile b/test-suite/golden-tests/typeclasses-1/Makefile
new file mode 100644
index 00000000..a9c8990d
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-1/Makefile
@@ -0,0 +1,8 @@
+all:
+	rm -f obs.txt
+	morloc make -v main.loc > log
+	./nexus.py foo 6 5 > obs.txt
+	./nexus.py bar '"a"' '"b"' >> obs.txt
+
+clean:
+	rm -f nexus* pool*
diff --git a/test-suite/golden-tests/typeclasses-1/exp.txt b/test-suite/golden-tests/typeclasses-1/exp.txt
new file mode 100644
index 00000000..94ea2c9f
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-1/exp.txt
@@ -0,0 +1,2 @@
+17.0
+"abyolo"
diff --git a/test-suite/golden-tests/typeclasses-1/main.loc b/test-suite/golden-tests/typeclasses-1/main.loc
new file mode 100644
index 00000000..ace05d88
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-1/main.loc
@@ -0,0 +1,29 @@
+module main (foo)
+
+type Cpp => Int = "int"
+type Cpp => Real = "double"
+type Cpp => Str = "std::string"
+
+type Py => Int = "int"
+type Py => Real = "float"
+type Py => Str = "str"
+
+class Add a where
+  add :: a -> a -> a
+
+instance Add Int where
+  source Cpp from "foo.hpp" ("addInt" as add)
+  source Py from "foo.py" ("addInt" as add)
+
+instance Add Real where
+  source Cpp from "foo.hpp" ("addReal" as add)
+  source Py from "foo.py" ("addReal" as add)
+
+instance Add Str where
+  source Cpp from "foo.hpp" ("addStr" as add)
+  source Py from "foo.py" ("addStr" as add)
+
+bar :: Real -> Real -> Real
+bar x y = add x (add y x)
+
+foo x y = add x (add y "yolo")

From 30990f21e8a0dd29f59e9faa61ba17b044f3ed72 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 21 Jan 2024 17:40:07 -0500
Subject: [PATCH 03/14] Add parser handling for typeclasses and instances

---
 library/Morloc/Frontend/AST.hs         |  8 +--
 library/Morloc/Frontend/Lexer.hs       |  2 +
 library/Morloc/Frontend/Parser.hs      | 74 ++++++++++++++++++--------
 library/Morloc/Frontend/Pretty.hs      |  2 +-
 library/Morloc/Frontend/Restructure.hs |  6 +--
 library/Morloc/Frontend/Treeify.hs     | 28 +++++++++-
 library/Morloc/Namespace.hs            | 12 ++++-
 7 files changed, 98 insertions(+), 34 deletions(-)

diff --git a/library/Morloc/Frontend/AST.hs b/library/Morloc/Frontend/AST.hs
index e6d59d1f..f4bfd98e 100644
--- a/library/Morloc/Frontend/AST.hs
+++ b/library/Morloc/Frontend/AST.hs
@@ -63,7 +63,7 @@ findSignatureTypeTerms :: ExprI -> [TVar]
 findSignatureTypeTerms = unique . f where
   f :: ExprI -> [TVar]
   f (ExprI _ (ModE _ es)) = concatMap f es
-  f (ExprI _ (SigE _ _ (EType t _ _))) = findTypeTerms t
+  f (ExprI _ (SigE (Signature _ _ (EType t _ _)))) = findTypeTerms t
   f (ExprI _ (AssE _ _ es)) = concatMap f es
   f _ = []
 
@@ -85,9 +85,9 @@ findSignatures :: ExprI -> [(EVar, Maybe Label, EType)]
 -- v is the name of the type
 -- l is the optional label for the signature
 -- t is the type
-findSignatures (ExprI _ (ModE _ es)) = [(v, l, t) | (ExprI _ (SigE v l t)) <- es]
-findSignatures (ExprI _ (AssE _ _ es)) = [(v, l, t) | (ExprI _ (SigE v l t)) <- es]
-findSignatures (ExprI _ (SigE v l t)) = [(v, l, t)]
+findSignatures (ExprI _ (ModE _ es)) = [(v, l, t) | (ExprI _ (SigE (Signature v l t))) <- es]
+findSignatures (ExprI _ (AssE _ _ es)) = [(v, l, t) | (ExprI _ (SigE (Signature v l t))) <- es]
+findSignatures (ExprI _ (SigE (Signature v l t))) = [(v, l, t)]
 findSignatures _ = []
 
 checkExprI :: Monad m => (ExprI -> m ()) -> ExprI -> m ()
diff --git a/library/Morloc/Frontend/Lexer.hs b/library/Morloc/Frontend/Lexer.hs
index 98d6e59e..2a7903c8 100644
--- a/library/Morloc/Frontend/Lexer.hs
+++ b/library/Morloc/Frontend/Lexer.hs
@@ -246,6 +246,8 @@ reservedWords =
   , "True"
   , "False"
   , "type"
+  , "instance"
+  , "class"
   ]
 
 operatorChars :: String
diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index cb2d50dd..a88e8f2b 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -103,7 +103,7 @@ pModule expModuleName = do
     findSymbols :: ExprI -> Set.Set Symbol
     findSymbols (ExprI _ (TypE _ v _ _)) = Set.singleton $ TypeSymbol v
     findSymbols (ExprI _ (AssE e _ _)) = Set.singleton $ TermSymbol e
-    findSymbols (ExprI _ (SigE e _ t)) = Set.union (Set.singleton $ TermSymbol e) (packedType t)
+    findSymbols (ExprI _ (SigE (Signature e _ t))) = Set.union (Set.singleton $ TermSymbol e) (packedType t)
     findSymbols (ExprI _ (ImpE (Import _ (Just imps) _ _)))
         = Set.fromList $ [TermSymbol alias | (AliasedTerm _ alias) <- imps] <>
                          [TypeSymbol alias | (AliasedType _ alias) <- imps]
@@ -156,7 +156,7 @@ createMainFunction es = case (init es, last es) of
     (_, ExprI _ TypE{}) -> return es
     (_, ExprI _ (ImpE _))     -> return es
     (_, ExprI _ (SrcE _))     -> return es
-    (_, ExprI _ SigE{}) -> return es
+    (_, ExprI _ (SigE _)) -> return es
     (_, ExprI _ AssE{}) -> return es
     (_, ExprI _ (ExpE _))     -> return es
     (rs, terminalExpr) -> do
@@ -170,6 +170,8 @@ pTopExpr :: Parser [ExprI]
 pTopExpr = 
       try (plural pImport)
   <|> try (plural pTypedef)
+  <|> try (plural pTypeclass)
+  <|> try (plural pInstance)
   <|> try (plural pAssE)
   <|> try (plural pSigE)
   <|> try pSrcE
@@ -262,6 +264,21 @@ pImport = do
     a <- option n (reserved "as" >> freenameU)
     return (AliasedType (TV n) (TV a))
 
+pTypeclass :: Parser ExprI
+pTypeclass = do
+  _ <- reserved "class"
+  (TV v, vs) <- pTypedefTerm <|> parens pTypedefTerm
+  sigs <- option [] (reserved "where" >> alignInset pSignature)
+  exprI $ ClsE (Typeclass v) vs sigs
+
+pInstance :: Parser ExprI
+pInstance = do
+  _ <- reserved "instance"
+  v <- freenameU
+  ts <- many1 pType
+  srcs <- option [] (reserved "where" >> alignInset pSource) |>> concat
+  srcEs <- mapM (exprI . SrcE) srcs
+  exprI $ IstE (Typeclass v) ts srcEs
 
 pTypedef :: Parser ExprI
 pTypedef = try pTypedefType <|> pTypedefObject where
@@ -313,12 +330,6 @@ pTypedef = try pTypedefType <|> pTypedefObject where
     let t = NamU o (TV con) (map VarU vs) (map (first Key) entries)
     exprI (TypE k v vs t)
 
-  pTypedefTerm :: Parser (TVar, [TVar])
-  pTypedefTerm = do
-    t <- freenameU
-    ts <- many freenameL
-    return (TV t, map TV ts)
-
   -- TODO: is this really the right place to be doing this?
   desugarTableEntries
     :: NamType
@@ -355,6 +366,12 @@ pTypedef = try pTypedefType <|> pTypedefObject where
     _ <- symbol "=>"
     return lang
 
+pTypedefTerm :: Parser (TVar, [TVar])
+pTypedefTerm = do
+  t <- freenameU
+  ts <- many freenameL
+  return (TV t, map TV ts)
+
 
 pAssE :: Parser ExprI
 pAssE = try pFunctionAssE <|> pDataAssE
@@ -391,21 +408,25 @@ pAssE = try pFunctionAssE <|> pDataAssE
 
 pSigE :: Parser ExprI
 pSigE = do
+  signature <- pSignature
+  exprI . SigE $ signature
+
+pSignature :: Parser Signature
+pSignature = do
   label' <- tag freename
   v <- freenameL
   _ <- op "::"
   props <- option [] (try pPropertyList)
   t <- pTypeGen
   constraints <- option [] pConstraints
-  exprI $
-    SigE
-      (EV v)
-      (Label <$> label')
-      (EType
-         { etype = t
-         , eprop = Set.fromList props
-         , econs = Set.fromList constraints
-         })
+  return $ Signature
+    (EV v)
+    (Label <$> label')
+    (EType
+       { etype = t
+       , eprop = Set.fromList props
+       , econs = Set.fromList constraints
+       })
   where
 
   pPropertyList :: Parser [Property]
@@ -437,6 +458,11 @@ pSigE = do
 
 pSrcE :: Parser [ExprI]
 pSrcE = do
+  srcs <- pSource
+  mapM (exprI . SrcE) srcs
+
+pSource :: Parser [Source]
+pSource = do
   reserved "source"
   modulePath <- CMS.gets stateModulePath
   language <- pLang
@@ -452,12 +478,14 @@ pSrcE = do
     -- this case SHOULD only occur in testing where the source file does not exist
     -- file non-existence will be caught later
     (Nothing, s) -> return s 
-  mapM exprI [SrcE $ Source { srcName = srcVar
-                            , srcLang = language
-                            , srcPath = srcFile
-                            , srcAlias = aliasVar
-                            , srcLabel = Label <$> label'
-                            } | (srcVar, aliasVar, label') <- rs]
+  return [
+    Source
+      { srcName = srcVar
+      , srcLang = language
+      , srcPath = srcFile
+      , srcAlias = aliasVar
+      , srcLabel = Label <$> label'
+      } | (srcVar, aliasVar, label') <- rs]
   where
 
   pImportSourceTerm :: Parser (SrcName, EVar, Maybe MT.Text)
diff --git a/library/Morloc/Frontend/Pretty.hs b/library/Morloc/Frontend/Pretty.hs
index b2f36ad7..a4fe7868 100644
--- a/library/Morloc/Frontend/Pretty.hs
+++ b/library/Morloc/Frontend/Pretty.hs
@@ -51,7 +51,7 @@ instance Pretty Expr where
     <+> "("
     <> dquotes (pretty name) <+> "as" <+>  pretty alias <> maybe "" (\s -> ":" <> pretty s) label
     <> ")"
-  pretty (SigE v _ e) =
+  pretty (SigE (Signature v _ e)) =
     pretty v <+> "::" <+> eprop' <> etype' <> econs'
     where
       eprop' :: Doc ann
diff --git a/library/Morloc/Frontend/Restructure.hs b/library/Morloc/Frontend/Restructure.hs
index 40a7abd0..1b5f3461 100644
--- a/library/Morloc/Frontend/Restructure.hs
+++ b/library/Morloc/Frontend/Restructure.hs
@@ -256,13 +256,13 @@ evaluateAllTypes = MDD.mapNodeM f where
   f e0 = do
     g e0 where
       g :: ExprI -> MorlocMonad ExprI
-      g (ExprI i (SigE v l e)) = do
+      g (ExprI i (SigE (Signature v l e))) = do
         gscope <- MM.metaGeneralTypedefs i
         e' <- evaluateEType gscope e
         MM.sayVVV $ "evaluateEType"
           <> "\n  e:" <+> pretty (etype e)
           <> "\n  e':" <+> pretty (etype e')
-        return $ ExprI i (SigE v l e')
+        return $ ExprI i (SigE (Signature v l e'))
       g (ExprI i (AnnE e ts)) = do
         gscope <- MM.metaGeneralTypedefs i
         ts' <- mapM (evaluateTypeU gscope) ts
@@ -421,7 +421,7 @@ rename sourceName localAlias = f where
 nullify :: DAG m e ExprI -> DAG m e ExprI
 nullify = MDD.mapNode f where
     f :: ExprI -> ExprI
-    f (ExprI i (SigE v n (EType t ps cs))) = ExprI i (SigE v n (EType (nullifyT t) ps cs))
+    f (ExprI i (SigE (Signature v n (EType t ps cs)))) = ExprI i (SigE (Signature v n (EType (nullifyT t) ps cs)))
     f (ExprI i (ModE m es)) = ExprI i (ModE m (map f es))
     f (ExprI i (AssE v e es)) = ExprI i (AssE v (f e) (map f es))
     f e = e
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index b24b77ba..8bd728da 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -63,6 +63,9 @@ treeify d
      -- - the map won't be used until the type inference step in Typecheck.hs
      _ <- DAG.synthesizeDAG linkSignaturesModule d'
 
+     -- build typeclasses and instance map
+     _ <- DAG.synthesizeDAG linkTypeclasses d'
+
      {- example d' for
       -  x = 42
       -  x
@@ -121,6 +124,27 @@ term --<i>--.--<
               `------------------------n--> General Signature
 -}
 
+linkTypeclasses
+  :: MVar
+  -> ExprI
+  -> [(m, e, Map.Map EVar (Typeclass, EType, [TermTypes]))]
+  -> MorlocMonad (Map.Map EVar (Typeclass, EType, [TermTypes]))
+linkTypeclasses _ e es = do
+  cls <- findTypeclasses e
+  Map.unionsWithM mergeTypeclasses (cls : [x | (_,_,x) <- es])
+
+findTypeclasses :: ExprI -> MorlocMonad (Map.Map EVar (Typeclass, EType, [TermTypes]))
+findTypeclasses _ = return Map.empty
+
+mergeTypeclasses
+  :: (Typeclass, EType, [TermTypes])
+  -> (Typeclass, EType, [TermTypes])
+  -> MorlocMonad (Typeclass, EType, [TermTypes])
+mergeTypeclasses (cls1, t1, ts1) (cls2, t2, ts2)
+  | cls1 /= cls2 = error "Conflicting typeclasses"
+  | t1 /= t2 = error "Conflicting typeclass term general type"
+    -- here I should do reciprocal subtyping
+  | otherwise = return (cls1, t1, ts1 <> ts2)
 
 
 -- in each scope (top of a module or after descending into a where statement) 
@@ -232,7 +256,7 @@ unifyTermTypes mv xs m0
   >>= Map.unionWithM combineTermTypes m0
   >>= Map.unionWithM combineTermTypes decs
   where
-  sigs = Map.fromListWith (<>) [((v, l, Nothing), [t]) | (ExprI _ (SigE v l t)) <- xs]
+  sigs = Map.fromListWith (<>) [((v, l, Nothing), [t]) | (ExprI _ (SigE (Signature v l t))) <- xs]
   srcs = Map.fromListWith (<>) [((srcAlias s, srcLabel s, langOf s), [(s, i)]) | (ExprI i (SrcE s)) <- xs]
   decs = Map.map (TermTypes Nothing []) $ Map.fromListWith (<>) [(v, [e]) | (ExprI _ (AssE v e _)) <- xs]
 
@@ -471,7 +495,7 @@ collectSExpr (ExprI i e0) = (,) <$> f e0 <*> pure i
   f (ImpE _) = error "impossible"
   f (ExpE _) = error "impossible"
   f (SrcE _) = error "impossible"
-  f SigE {} = error "impossible"
+  f (SigE _) = error "impossible"
   f AssE {} = error "impossible"
 
 reindexExprI :: ExprI -> MorlocMonad ExprI
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index 623b38b0..d321b5cb 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -32,6 +32,7 @@ module Morloc.Namespace
   , MVar(..)
   , EVar(..)
   , TVar(..)
+  , Typeclass(..)
   , CVar(..)
   , Key(..)
   , Label(..)
@@ -75,6 +76,7 @@ module Morloc.Namespace
   -- * Mostly frontend expressions
   , Symbol(..)
   , AliasedSymbol(..)
+  , Signature(..)
   , Expr(..)
   , ExprI(..)
   , Import(..)
@@ -153,6 +155,7 @@ data MorlocState = MorlocState
   , stateDepth :: Int
   -- ^ store depth in the SAnno tree in the frontend and backend typecheckers
   , stateSignatures :: GMap Int Int TermTypes
+  , stateTypeclassTerms :: GMap Int Int (Typeclass, EType, [TermTypes])
   , stateConcreteTypedefs :: GMap Int MVar (Map Lang Scope)
   -- ^ stores type functions that are in scope for a given module and language
   , stateGeneralTypedefs  :: GMap Int MVar           Scope
@@ -258,6 +261,9 @@ data Exports = ExportMany (Set.Set Symbol) | ExportAll
 data AliasedSymbol = AliasedType TVar TVar | AliasedTerm EVar EVar
   deriving (Show, Ord, Eq)
 
+data Signature = Signature EVar (Maybe Label) EType
+  deriving (Show, Ord, Eq)
+
 data ExprI = ExprI Int Expr
   deriving (Show, Ord, Eq)
 
@@ -265,6 +271,8 @@ data ExprI = ExprI Int Expr
 data Expr
   = ModE MVar [ExprI]
   -- ^ the toplevel expression in a module
+  | ClsE Typeclass [TVar] [Signature]
+  | IstE Typeclass [TypeU] [ExprI]
   | TypE (Maybe (Lang, Bool)) TVar [TVar] TypeU
   -- ^ a type definition
   --   1. the language, Nothing is general
@@ -278,7 +286,7 @@ data Expr
   -- ^ a term that is exported from a module (should only exist at the toplevel)
   | SrcE Source
   -- ^ import "c" from "foo.c" ("f" as yolo).
-  | SigE EVar (Maybe Label) EType
+  | SigE Signature
   -- ^ A type signature, the three parameters correspond to the term name, the
   -- optional label, and the type
   | AssE EVar ExprI [ExprI]
@@ -516,6 +524,8 @@ newtype EVar = EV { unEVar :: Text } deriving (Show, Eq, Ord)
 -- A type general name
 newtype TVar = TV { unTVar :: Text } deriving (Show, Eq, Ord)
 
+newtype Typeclass = Typeclass { unTypeclass :: Text } deriving (Show, Eq, Ord)
+
 -- A concrete type name
 newtype CVar = CV { unCVar :: Text } deriving (Show, Eq, Ord)
 

From 32aded7c8a97987710262297c7b7ff986edc35a2 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Mon, 22 Jan 2024 08:41:37 -0500
Subject: [PATCH 04/14] (1/408 fail) Add typeclass info to state

Next I need to look up typeclass functions in the frontend checker
at the point where I resolve terms. Then I can update `stateSources`
with links to the instance sources for each term.

That should be all that is required. In the generator all that matters
is the inferred general type (which is stored in the SAnno object) and
the index to the source.

A little additional work will be needed if I want to validate the
correctness of any given or omitted typeclass constraints.
---
 library/Morloc/Frontend/Treeify.hs | 157 +++++++++++++++++++++++------
 1 file changed, 125 insertions(+), 32 deletions(-)

diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index 8bd728da..9f2ccf06 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -14,6 +14,7 @@ module Morloc.Frontend.Treeify (treeify) where
 import Morloc.Frontend.Namespace
 import Morloc.Data.Doc
 import Morloc.Pretty ()
+import qualified Control.Monad as CM
 import qualified Control.Monad.State as CMS
 import qualified Morloc.Frontend.AST as AST
 import qualified Morloc.Monad as MM
@@ -124,29 +125,6 @@ term --<i>--.--<
               `------------------------n--> General Signature
 -}
 
-linkTypeclasses
-  :: MVar
-  -> ExprI
-  -> [(m, e, Map.Map EVar (Typeclass, EType, [TermTypes]))]
-  -> MorlocMonad (Map.Map EVar (Typeclass, EType, [TermTypes]))
-linkTypeclasses _ e es = do
-  cls <- findTypeclasses e
-  Map.unionsWithM mergeTypeclasses (cls : [x | (_,_,x) <- es])
-
-findTypeclasses :: ExprI -> MorlocMonad (Map.Map EVar (Typeclass, EType, [TermTypes]))
-findTypeclasses _ = return Map.empty
-
-mergeTypeclasses
-  :: (Typeclass, EType, [TermTypes])
-  -> (Typeclass, EType, [TermTypes])
-  -> MorlocMonad (Typeclass, EType, [TermTypes])
-mergeTypeclasses (cls1, t1, ts1) (cls2, t2, ts2)
-  | cls1 /= cls2 = error "Conflicting typeclasses"
-  | t1 /= t2 = error "Conflicting typeclass term general type"
-    -- here I should do reciprocal subtyping
-  | otherwise = return (cls1, t1, ts1 <> ts2)
-
-
 -- in each scope (top of a module or after descending into a where statement) 
 --  1 collect all type signatures (Map EVar [EType])
 --  2 find all equivalent appearences of a given term across modules (including across aliases)
@@ -487,16 +465,17 @@ collectSExpr (ExprI i e0) = (,) <$> f e0 <*> pure i
   f (IntE x) = return (IntS x)
   f (LogE x) = return (LogS x)
   f (StrE x) = return (StrS x)
-
   -- none of the following cases should ever occur
-  f (AnnE _ _) = error "impossible"
-  f (ModE _ _) = error "impossible"
-  f TypE {} = error "impossible"
-  f (ImpE _) = error "impossible"
-  f (ExpE _) = error "impossible"
-  f (SrcE _) = error "impossible"
-  f (SigE _) = error "impossible"
-  f AssE {} = error "impossible"
+  f ClsE{} = undefined
+  f IstE{} = undefined
+  f AnnE{} = undefined
+  f ModE{} = undefined
+  f TypE{} = undefined
+  f ImpE{} = undefined
+  f ExpE{} = undefined
+  f SrcE{} = undefined
+  f SigE{} = undefined
+  f AssE{} = undefined
 
 reindexExprI :: ExprI -> MorlocMonad ExprI
 reindexExprI (ExprI i e) = ExprI <$> newIndex i <*> reindexExpr e
@@ -521,3 +500,117 @@ newIndex i = do
   i' <- MM.getCounter
   copyState i i'
   return i'
+
+
+linkTypeclasses
+  :: MVar
+  -> ExprI
+  -> [(m, e, Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))]
+  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+linkTypeclasses _ e es
+  -- Merge the typeclasses and instances from all imported modules
+  -- These are inherited implicitly, so import terms are ignored
+  = Map.unionsWithM mergeTypeclasses [x | (_,_,x) <- es]
+  -- Augment the inherited map with the typeclasses and instances in this module
+  >>= findTypeclasses e
+
+findTypeclasses
+  :: ExprI
+  -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+findTypeclasses (ExprI moduleIndex (ModE moduleName es0)) priorClasses = do
+  -- typeclass definitions live only at the top-level, so need to recursively
+  -- descend into the expressions in a module
+  
+  -- first we collect all typeclass definitions in this module
+  localClasses <- Map.unionsWithM mergeTypeclasses 
+                . map makeClass
+                $ [(cls, vs, sigs) | (ExprI _ (ClsE cls vs sigs)) <- es0]
+  -- then merge them with all prior typeclasses and instances
+  allClasses <- Map.unionWithM mergeTypeclasses priorClasses localClasses
+  -- find instances in this module
+  let instances = [(cls, ts, es) | (ExprI _ (IstE cls ts es)) <- es0]
+  -- fold the instances into the current typeclass map and return
+  moduleClasses <- foldlM addInstance allClasses instances
+
+  mapM_ (linkVariablesToTypeclasses moduleClasses) es0
+
+  return moduleClasses
+
+  where
+    -- make a map of all terms that are defined in a typeclass (these will all
+    -- be general term)
+    makeClass :: (Typeclass, [TVar], [Signature]) -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+    makeClass (cls, vs, sigs) = Map.fromList $ map makeClassTerm sigs where
+      makeClassTerm :: Signature -> (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      makeClassTerm (Signature v _ t) = (v, (cls, vs, t, []))
+
+    addInstance
+      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+      -> (Typeclass, [TypeU], [ExprI])
+      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])) 
+    addInstance clsmap (_, _, []) = return clsmap 
+    addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromList where
+      f :: ExprI -> MorlocMonad (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      f (ExprI srcIndex (SrcE src)) =
+        case Map.lookup (srcAlias src) clsmap of 
+          (Just (cls1, vs, generalType, otherInstances)) -> do
+            when (cls1 /= cls0) (error "Conflicting instances")
+            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
+            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (etype generalType) (zip vs ts0) }
+            let newTerm = TermTypes (Just instanceType) [(moduleName, Idx srcIndex src)] []
+            let typeterms = newTerm : filter (noInstanceInLang (srcLang src)) otherInstances
+            return (srcAlias src, (cls0, vs, instanceType, typeterms))
+          Nothing -> error "No typeclass found for instance"
+      f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
+
+      noInstanceInLang :: Lang -> TermTypes -> Bool
+      noInstanceInLang lang otherTerm = lang `notElem` (map (srcLang . val . snd) . termConcrete $ otherTerm)
+
+    linkVariablesToTypeclasses
+      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+      -> ExprI
+      -> MorlocMonad ()
+    linkVariablesToTypeclasses = link where
+      link :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> ExprI -> MorlocMonad ()
+      -- The following may have terms from typeclasses
+      -- 1. variables
+      link m (ExprI i (VarE v)) = setClass m i v
+      -- recurse into assignments, allow shadowing of typeclass functions (TODO: warn)
+      link m (ExprI _ (AssE _ (ExprI _ (LamE ks e)) es)) = do
+        -- shadow all terms bound under the lambda
+        let m' = foldr Map.delete m ks
+        mapM_ (link m') (e:es)
+      -- modules currently cannot be nested (should this be allowed?)
+      link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
+      -- everything below boilerplate
+      link m (ExprI _ (AccE e _)) = link m e
+      link m (ExprI _ (LstE xs)) = mapM_ (link m) xs
+      link m (ExprI _ (TupE xs)) = mapM_ (link m) xs
+      link m (ExprI _ (LamE vs e)) = link (foldr Map.delete m vs) e
+      link m (ExprI _ (AppE f es)) = link m f >> mapM_ (link m) es
+      link m (ExprI _ (AnnE e _)) = link m e
+      link m (ExprI _ (NamE rs)) = mapM_ (link m . snd) rs
+      link _ _ = return ()
+
+      setClass :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
+      setClass m termIndex v = case Map.lookup v m of
+        (Just (cls, _, t, ts)) -> do
+          s <- CMS.get
+          let newMap = GMap.insert termIndex moduleIndex (cls, t, ts) (stateTypeclassTerms s)
+          CMS.put (s { stateTypeclassTerms = newMap } )
+          return ()
+        Nothing -> return ()
+findTypeclasses _ _ = undefined 
+
+
+mergeTypeclasses
+  :: (Typeclass, [TVar], EType, [TermTypes])
+  -> (Typeclass, [TVar], EType, [TermTypes])
+  -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
+mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
+  | cls1 /= cls2 = error "Conflicting typeclasses"
+  | t1 /= t2 = error "Conflicting typeclass term general type"
+  | length vs1 /= length vs2 = error "Conflicting typeclass parameter count"
+  -- here I should do reciprocal subtyping
+  | otherwise = return (cls1, vs1, t1, ts1 <> ts2)

From eb4769738c85cd84093d9bb915bf2d85662134b6 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sat, 27 Jan 2024 21:58:47 -0500
Subject: [PATCH 05/14] (all pass) First test of typeclasses passes

The parser reads class and instance syntax into ClsE and InstE terms.

Treeify stores these in the stateSignatures field under a new
SignatureSet type:

```
data SignatureSet
    = Monomorphic TermTypes
    | Polymorphic Typeclass EVar EType [TermTypes]
```

That separates monomorphic and polymorphic types (instances of class
functions).

Treeify also rewrites polymorphic functions as CallE expressions (as was
with monomorphic terms.

Within the typechecker, little changes. When polymorphic terms are
looked up in `stateSignatures` the class signatures are returned (not
the instance types).

After type inference, terms and term types are filtered out if inferred
subtype is not a subtype of the instance type.

No further changes are required after this.

TODO:

  [ ] Systematic testing of typeclasses (e.g., multiple parameters,
      overlapping instances, non-fully-resolved instances, etc).

  [ ] Systematic testing of constraint testing and inference

  [ ] Add constraint checking and inference

  [ ] Make Packable typeclass; replace the special (un)pack handling

The passing test is for `add` over ints, reals, and strings. Before
moving on to typeclassifying (un)pack handling, I should carefully test
based typeclasses.
---
 executable/Subcommands.hs                     |   4 +-
 library/Morloc/CodeGenerator/Generate.hs      |   6 +-
 library/Morloc/Data/GMap.hs                   |  19 +-
 library/Morloc/Frontend/Pretty.hs             |  68 -------
 library/Morloc/Frontend/Treeify.hs            | 191 ++++++++++--------
 library/Morloc/Frontend/Typecheck.hs          | 124 +++++++++---
 library/Morloc/Monad.hs                       |  32 ++-
 library/Morloc/Namespace.hs                   |   7 +-
 library/Morloc/Pretty.hs                      |  79 +++++++-
 library/Morloc/Typecheck/Internal.hs          |  14 +-
 .../golden-tests/typeclasses-1/Makefile       |   4 +-
 test-suite/golden-tests/typeclasses-1/exp.txt |   2 +-
 test-suite/golden-tests/typeclasses-1/foo.hpp |  18 ++
 test-suite/golden-tests/typeclasses-1/foo.py  |   8 +
 .../golden-tests/typeclasses-1/main.loc       |   2 +-
 15 files changed, 372 insertions(+), 206 deletions(-)
 delete mode 100644 library/Morloc/Frontend/Pretty.hs
 create mode 100644 test-suite/golden-tests/typeclasses-1/foo.hpp
 create mode 100644 test-suite/golden-tests/typeclasses-1/foo.py

diff --git a/executable/Subcommands.hs b/executable/Subcommands.hs
index b332b93a..01e58ae9 100644
--- a/executable/Subcommands.hs
+++ b/executable/Subcommands.hs
@@ -22,7 +22,6 @@ import qualified Morloc.Data.GMap as GMap
 import Morloc.CodeGenerator.Namespace (SerialManifold(..))
 import Morloc.CodeGenerator.Grammars.Translator.PseudoCode (pseudocodeSerialManifold)
 import Morloc.Pretty ()
-import Morloc.Frontend.Pretty ()
 import Morloc.Data.Doc
 import Text.Megaparsec.Error (errorBundlePretty)
 import qualified Data.Map as Map
@@ -121,7 +120,8 @@ writeTerm s i typeDoc =
     case ( Map.lookup i (stateName s)
          , GMap.lookup i (stateSignatures s))
     of
-        (Just v, GMapJust TermTypes{termGeneral = Just t'}) -> pretty v <+> "::" <+> pretty t'
+        (Just v, GMapJust (Monomorphic TermTypes{termGeneral = Just t'})) -> pretty v <+> "::" <+> pretty t'
+        (Just _, GMapJust (Polymorphic cls v t _)) -> "class" <+> pretty cls <+> pretty v <+> "::" <+> pretty (etype t)
         (Just v, _) -> pretty v <+> "|-" <+> typeDoc
         _ -> "MISSING"
 
diff --git a/library/Morloc/CodeGenerator/Generate.hs b/library/Morloc/CodeGenerator/Generate.hs
index 09c96bd9..c5936dec 100644
--- a/library/Morloc/CodeGenerator/Generate.hs
+++ b/library/Morloc/CodeGenerator/Generate.hs
@@ -444,9 +444,9 @@ generalSerial x0@(SAnno _ (Idx i t)) = do
       return $ ncmd { commandArgs = vs }
     generalSerial' base ps (SAnno (One (VarS (EV v), _)) _) =
       return $ base { commandSubs = [(ps, v, [])] }
-    generalSerial' _ _ (SAnno (One _) (Idx _ gt)) = do
-      MM.throwError . OtherError . render $
-        "Cannot serialize general type:" <+> pretty gt
+    -- bad states
+    generalSerial' NexusCommand{} _ (SAnno (One (AppS _ _, ())) _) = error "Functions should not occur here, observed AppS"
+    generalSerial' NexusCommand{} _ (SAnno (One (CallS _, ())) _) = error "Functions should not occur here, observed CallS"
 
 
 {- | Remove lambdas introduced through substitution
diff --git a/library/Morloc/Data/GMap.hs b/library/Morloc/Data/GMap.hs
index 2da1fd8f..a780f111 100644
--- a/library/Morloc/Data/GMap.hs
+++ b/library/Morloc/Data/GMap.hs
@@ -12,6 +12,8 @@ module Morloc.Data.GMap
   , empty
   , innerKeys
   , insert
+  , insertWith
+  , insertWithM
   , change
   , insertMany
   , insertManyWith
@@ -48,7 +50,7 @@ mapValsWithKeyM f (GMap m1 m2) = do
 mapKeys :: (Ord a') => (a -> a') -> GMap a b c -> GMap a' b c
 mapKeys f (GMap x y) = GMap (Map.mapKeys f x) y
 
-mapInnerKeys :: (Ord b') => (b -> b') -> GMap a b c -> GMap a b' c 
+mapInnerKeys :: (Ord b') => (b -> b') -> GMap a b c -> GMap a b' c
 mapInnerKeys f (GMap x y) = GMap (Map.map f x) (Map.mapKeys f y)
 
 keys :: GMap a b c -> [a]
@@ -64,7 +66,18 @@ empty :: GMap a b c
 empty = GMap Map.empty Map.empty
 
 insert :: (Ord a, Ord b) => a -> b -> c -> GMap a b c -> GMap a b c
-insert k1 k2 x (GMap m1 m2) = GMap (Map.insert k1 k2 m1) (Map.insert k2 x m2) 
+insert k1 k2 x (GMap m1 m2) = GMap (Map.insert k1 k2 m1) (Map.insert k2 x m2)
+
+insertWith :: (Ord a, Ord b) => (c -> c -> c) -> a -> b -> c -> GMap a b c -> GMap a b c
+insertWith f k1 k2 x (GMap m1 m2) = GMap (Map.insert k1 k2 m1) (Map.insertWith f k2 x m2)
+
+insertWithM :: (Monad m, Ord a, Ord b) => (c -> c -> m c) -> a -> b -> c -> GMap a b c -> m (GMap a b c)
+insertWithM f k1 k2 x1 (GMap m1 m2) = do
+  let map1 = Map.insert k1 k2 m1
+  x3 <- case Map.lookup k2 m2 of
+    (Just x2) -> f x1 x2
+    Nothing -> return x1
+  return $ GMap map1 (Map.insert k2 x3 m2)
 
 -- | Given an outer key, change the inner value. This may change the values
 -- associated with many other outer keys.
@@ -95,6 +108,6 @@ lookup :: (Ord a, Ord b) => a -> GMap a b c -> GMapRet c
 lookup k1 (GMap m1 m2) =
   case Map.lookup k1 m1 of
     Nothing -> GMapNoFst
-    (Just k2) -> case Map.lookup k2 m2 of 
+    (Just k2) -> case Map.lookup k2 m2 of
       Nothing -> GMapNoSnd
       (Just x) -> GMapJust x
diff --git a/library/Morloc/Frontend/Pretty.hs b/library/Morloc/Frontend/Pretty.hs
deleted file mode 100644
index a4fe7868..00000000
--- a/library/Morloc/Frontend/Pretty.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-{-|
-Module      : Morloc.Frontend.Pretty
-Description : Pretty is as pretty does
-Copyright   : (c) Zebulun Arendsee, 2021
-License     : GPL-3
-Maintainer  : zbwrnz@gmail.com
-Stability   : experimental
--}
-
-module Morloc.Frontend.Pretty (module Morloc.Pretty) where
-
-import Morloc.Frontend.Namespace
-import qualified Data.Set as Set
-import Morloc.Data.Doc hiding (putDoc)
-import Morloc.Pretty
-
-instance Pretty ExprI where
-  pretty (ExprI i e) = parens (pretty e) <> ":" <> pretty i
-
-instance Pretty Expr where
-  pretty UniE = "()"
-  pretty (ModE v es) = align . vsep $ ("module" <+> pretty v) : map pretty es
-  pretty (TypE lang v vs t)
-    = "type" <+> pretty lang <> "@" <> pretty v
-    <+> sep (map pretty vs) <+> "=" <+> pretty t
-  pretty (ImpE (Import m Nothing _ _)) = "import" <+> pretty m 
-  pretty (ImpE (Import m (Just xs) _ _)) = "import" <+> pretty m <+> tupled (map pretty xs)
-  pretty (ExpE v) = "export" <+> pretty v
-  pretty (VarE s) = pretty s
-  pretty (AccE e k) = parens (pretty e) <> "@" <> pretty k 
-  pretty (LamE v e) = "\\" <+> pretty v <+> "->" <+> pretty e
-  pretty (AnnE e ts) = parens
-    $   pretty e
-    <+> "::"
-    <+> encloseSep "(" ")" "; " (map pretty ts)
-  pretty (LstE es) = encloseSep "[" "]" "," (map pretty es)
-  pretty (TupE es) = encloseSep "[" "]" "," (map pretty es)
-  pretty (AppE f es) = vsep (map pretty (f:es))
-  pretty (NamE rs) = block 4 "<RECORD>" (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
-  pretty (RealE x) = pretty (show x)
-  pretty (IntE x) = pretty (show x)
-  pretty (StrE x) = dquotes (pretty x)
-  pretty (LogE x) = pretty x
-  pretty (AssE v e es) = pretty v <+> "=" <+> pretty e <+> "where" <+> (align . vsep . map pretty) es
-  pretty (SrcE (Source name lang file' alias label))
-    = "source"
-    <+> viaShow lang
-    <> maybe "" (\f -> "from" <+> pretty f) file' 
-    <+> "("
-    <> dquotes (pretty name) <+> "as" <+>  pretty alias <> maybe "" (\s -> ":" <> pretty s) label
-    <> ")"
-  pretty (SigE (Signature v _ e)) =
-    pretty v <+> "::" <+> eprop' <> etype' <> econs'
-    where
-      eprop' :: Doc ann
-      eprop' =
-        case Set.toList (eprop e) of
-          [] -> ""
-          xs -> tupled (map pretty xs) <+> "=> "
-      etype' :: Doc ann 
-      etype' = pretty (etype e)
-      econs' :: Doc ann
-      econs' =
-        case Set.toList (econs e) of
-          [] -> ""
-          xs -> " where" <+> tupled (map (\(Con x) -> pretty x) xs)
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index 9f2ccf06..5c7fd3b0 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -21,6 +21,7 @@ import qualified Morloc.Monad as MM
 import qualified Morloc.Data.DAG as DAG
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.Data.GMap as GMap
+import qualified Morloc.Frontend.PartialOrder as PO
 
 -- | Every term must either be sourced or declared.
 data TermOrigin = Declared ExprI | Sourced Source
@@ -125,14 +126,14 @@ term --<i>--.--<
               `------------------------n--> General Signature
 -}
 
--- in each scope (top of a module or after descending into a where statement) 
+-- in each scope (top of a module or after descending into a where statement)
 --  1 collect all type signatures (Map EVar [EType])
 --  2 find all equivalent appearences of a given term across modules (including across aliases)
 linkSignaturesModule
   :: MVar
   -> ExprI
   -> [(MVar, [(EVar, EVar)], Map.Map EVar TermTypes)]
-  -- ^ This is a list of 
+  -- ^ This is a list of
   -> MorlocMonad (Map.Map EVar TermTypes)
 linkSignaturesModule _ (ExprI _ (ModE v es)) edges
   -- a map from alias to all signatures associated with the alias
@@ -148,13 +149,13 @@ linkSignaturesModule _ (ExprI _ (ModE v es)) edges
   unalias es0 m =
     let aliases = Map.fromList . groupSort $ [(alias, srcname) | (srcname, alias) <- es0]
     in Map.map (mapMaybe (`Map.lookup` m)) aliases
-linkSignaturesModule _ _ _ = MM.throwError . CallTheMonkeys $ "Expected a module at the top level" 
+linkSignaturesModule _ _ _ = MM.throwError . CallTheMonkeys $ "Expected a module at the top level"
 
 
 linkSignatures
   :: MVar -- ^ the current module name
   -> [ExprI] -- ^ all expressions in the module
-  -> Map.Map EVar TermTypes -- ^ the inherited termtypes form imported modules 
+  -> Map.Map EVar TermTypes -- ^ the inherited termtypes form imported modules
   -> MorlocMonad (Map.Map EVar TermTypes)
 linkSignatures v es m = do
   -- find all top-level terms in this module
@@ -185,16 +186,16 @@ linkVariablesToTermTypes
   -> Map.Map EVar (Int, TermTypes) -- ^ a map term terms to types, Int is the inner GMAp key
   -> [ExprI] -- ^ list of expressions in the module
   -> MorlocMonad ()
-linkVariablesToTermTypes mv m0 = mapM_ (link m0) where 
+linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
   link :: Map.Map EVar (Int, TermTypes) -> ExprI -> MorlocMonad ()
   -- The following have terms associated with them:
   -- 1. exported terms (but not exported types)
-  link m (ExprI i (ExpE (TermSymbol v))) = setType m i v
+  link m (ExprI i (ExpE (TermSymbol v))) = setMonomorphicType m i v
   -- 2. variables
-  link m (ExprI i (VarE v)) = setType m i v
+  link m (ExprI i (VarE v)) = setMonomorphicType m i v
   -- 3. assignments
   link m (ExprI i (AssE v (ExprI _ (LamE ks e)) es)) = do
-    setType m i v
+    setMonomorphicType m i v
     -- shadow all terms bound under the lambda
     let m' = foldr Map.delete m ks
     -- then link the assignment term and all local "where" statements (es)
@@ -202,7 +203,7 @@ linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
     return ()
   -- 4. assignments that have no parameters
   link m (ExprI i (AssE v e es)) = do
-    setType m i v
+    setMonomorphicType m i v
     -- then link the assignment term and all local "where" statements (es)
     linkSignatures mv (e:es) (Map.map snd m)
     return ()
@@ -218,11 +219,11 @@ linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
   link m (ExprI _ (NamE rs)) = mapM_ (link m . snd) rs
   link _ _ = return ()
 
-  setType :: Map.Map EVar (Int, TermTypes) -> Int -> EVar -> MorlocMonad ()
-  setType m i v = case Map.lookup v m of 
+  setMonomorphicType :: Map.Map EVar (Int, TermTypes) -> Int -> EVar -> MorlocMonad ()
+  setMonomorphicType m i v = case Map.lookup v m of
     (Just (j, t)) -> do
       s <- CMS.get
-      CMS.put (s { stateSignatures = GMap.insert i j t (stateSignatures s)
+      CMS.put (s { stateSignatures = GMap.insert i j (Monomorphic t) (stateSignatures s)
                  , stateName = Map.insert i v (stateName s) } )
       return ()
     Nothing -> return ()
@@ -272,7 +273,7 @@ combineTermTypes (TermTypes g1 cs1 es1) (TermTypes g2 cs2 es2)
   maybeCombine f (Just a) (Just b) = Just <$> f a b
   maybeCombine _ (Just a) _ = return $ Just a
   maybeCombine _ _ (Just b) = return $ Just b
-  maybeCombine _ _ _ = return Nothing 
+  maybeCombine _ _ _ = return Nothing
 
 -- | This function defines how general types are merged. There are decisions
 -- encoded in this function that should be vary carefully considered.
@@ -285,49 +286,9 @@ mergeEType (EType t1 ps1 cs1) (EType t2 ps2 cs2)
 
 -- merge two general types
 mergeTypeUs :: TypeU -> TypeU -> MorlocMonad TypeU
-mergeTypeUs t1@(VarU v1) t2@(VarU v2)
-  | v1 == v2 = return (VarU v1)
-  | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2 
-mergeTypeUs (ExistU v ps1 rs1) (ExistU _ ps2 rs2)
-    = ExistU v
-    <$> zipWithM mergeTypeUs ps1 ps2
-    <*> mergeRecords rs1 rs2
-
-mergeTypeUs ExistU{} t = return t
-mergeTypeUs t ExistU{} = return t
-
--- Two universally qualified types may be merged if they are the same up to
--- named of bound variables, for example:
---  mergeTypeUs (forall a . a) (forall b . b) --> forall b . b
-mergeTypeUs (ForallU v1 t1) (ForallU v2 t2)
-  = ForallU v1 <$> mergeTypeUs (substituteTVar v2 (VarU v1) t2) t1
-mergeTypeUs (FunU ts1 t1) (FunU ts2 t2) = FunU <$> zipWithM mergeTypeUs ts1 ts2 <*> mergeTypeUs t1 t2 
-mergeTypeUs (AppU t1 ps1) (AppU t2 ps2) = AppU <$> mergeTypeUs t1 t2 <*> zipWithM mergeTypeUs ps1 ps2
-mergeTypeUs t1@(NamU o1 n1 ps1 ks1) t2@(NamU o2 n2 ps2 ks2)
-  | o1 == o2 && n1 == n2 && length ps1 == length ps2 = do
-      ts1 <- zipWithM mergeTypeUs (map snd ks1) (map snd ks2)
-      ps' <- zipWithM mergeTypeUs ps1 ps2 
-      return $ NamU o1 n1 ps' (zip (map fst ks1) ts1)
+mergeTypeUs t1 t2
+  | PO.equivalent t1 t2 = return t1
   | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
-mergeTypeUs t1 t2 = MM.throwError $ IncompatibleGeneralType t1 t2
--- mergeTypeUs t1 t2
---   | t1 `PO.isSubtypeOf` t2 = return t2
---   | t2 `PO.isSubtypeOf` t1 = return t1
---   | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
-
--- merge record entries by taking the union of entries
-mergeRecords :: [(Key, TypeU)] -> [(Key, TypeU)] -> MorlocMonad [(Key, TypeU)]
-mergeRecords rs1 rs2 = do
-  -- all record entries common to both types in the order of rs1
-  commonEntries <- mapM mergeRecord rs1
-  -- records that are unique to rs2
-  let missingRecords = [(k, t2) | (k, t2) <- rs2, isNothing (lookup k rs1)]
-  return $ commonEntries <> missingRecords
-  where
-  mergeRecord :: (Key, TypeU) -> MorlocMonad (Key, TypeU)
-  mergeRecord (k, t1) = case lookup k rs2 of
-    (Just t2) -> (,) k <$> mergeTypeUs t1 t2
-    Nothing -> return (k, t1)
 
 
 linkAndRemoveAnnotations :: ExprI -> MorlocMonad ExprI
@@ -358,13 +319,13 @@ linkAndRemoveAnnotations = f where
 --
 -- Recursion
 --   [ ] handle recursion and mutual recursion
---       - to detect recursion, I need to remember every term that has been expanded, 
+--       - to detect recursion, I need to remember every term that has been expanded,
 -- collect v declarations or sources
 collect
   :: Int -- ^ the index for the export term
   -> MorlocMonad (SAnno Int Many Int)
 collect i = do
-  t0 <- MM.metaTermTypes i
+  t0 <- MM.metaMonomorphicTermTypes i
   case t0 of
     -- if Nothing, then the term is a bound variable
     Nothing -> return (SAnno (Many []) i)
@@ -376,16 +337,18 @@ collect i = do
 
 collectSAnno :: ExprI -> MorlocMonad (SAnno Int Many Int)
 collectSAnno e@(ExprI i (VarE v)) = do
-  t0 <- MM.metaTermTypes i
-  es <- case t0 of
+  maybeTermTypes <- MM.metaTermTypes i
+
+  es <- case maybeTermTypes of
     -- if Nothing, then the term is a bound variable
     Nothing -> return <$> collectSExpr e
+    (Just []) -> error "No instances"
     -- otherwise is an alias that should be replaced with its value(s)
-    (Just t1) -> do
-      -- collect all the concrete calls with this name
-      let calls = [(CallS src, i') | (_, Idx i' src) <- termConcrete t1]
-      -- collect all the morloc compositions with this name
-      declarations <- mapM reindexExprI (termDecl t1) >>= mapM (replaceExpr i) |>> concat
+    (Just ts) -> do
+      -- collect all the concrete calls across all instances
+      let calls = [(CallS src, i') | (_, Idx i' src) <- concatMap termConcrete ts]
+      -- collect all the morloc compositions with this name across all instances
+      declarations <- mapM reindexExprI (concatMap termDecl ts) >>= mapM (replaceExpr i) |>> concat
       -- link this index to the name that is removed
       s <- CMS.get
       CMS.put (s { stateName = Map.insert i v (stateName s) })
@@ -404,7 +367,7 @@ collectSAnno e@(ExprI i (VarE v)) = do
 -- expression type annotations should have already been accounted for, so ignore
 collectSAnno (ExprI _ (AnnE e _)) = collectSAnno e
 collectSAnno e@(ExprI i _) = do
-  e' <- collectSExpr e 
+  e' <- collectSExpr e
   return $ SAnno (Many [e']) i
 
 -- | This function will handle terms that have been set to be equal
@@ -415,17 +378,17 @@ replaceExpr :: Int -> ExprI -> MorlocMonad [(SExpr Int Many Int, Int)]
 replaceExpr i e@(ExprI j (VarE _)) = do
   x <- collectSAnno e
   -- unify the data between the equated terms
-  tiMay <- MM.metaTermTypes i
-  tjMay <- MM.metaTermTypes j
+  tiMay <- MM.metaMonomorphicTermTypes i
+  tjMay <- MM.metaMonomorphicTermTypes j
   t <- case (tiMay, tjMay) of
-    (Just ti, Just tj) -> combineTermTypes ti tj 
+    (Just ti, Just tj) -> combineTermTypes ti tj
     (Just ti, _) -> return ti
     (_, Just tj) -> return tj
     _ -> error "You shouldn't have done that"
 
   st <- MM.get
 
-  case GMap.change i t (stateSignatures st) of
+  case GMap.change i (Monomorphic t) (stateSignatures st) of
     (Just m) -> MM.modify (\s -> s {stateSignatures = m})
     _ -> error "impossible"
 
@@ -518,18 +481,25 @@ findTypeclasses
   :: ExprI
   -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
   -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
-findTypeclasses (ExprI moduleIndex (ModE moduleName es0)) priorClasses = do
-  -- typeclass definitions live only at the top-level, so need to recursively
-  -- descend into the expressions in a module
-  
+findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
+
   -- first we collect all typeclass definitions in this module
-  localClasses <- Map.unionsWithM mergeTypeclasses 
+  -- typeclasses are defined only at the top-level, so no descent into sub-expressions
+  localClasses <- Map.unionsWithM mergeTypeclasses
                 . map makeClass
                 $ [(cls, vs, sigs) | (ExprI _ (ClsE cls vs sigs)) <- es0]
+
   -- then merge them with all prior typeclasses and instances
   allClasses <- Map.unionWithM mergeTypeclasses priorClasses localClasses
+
   -- find instances in this module
+  -- The (IstE cls ts es) terms refer to
+  --   cls: typeclass, such as "Packable"
+  --   ts: types, such as ["Map a b", "[(a,b)]"]
+  --   es: instance definitions, such as source statements (the only ones
+  --       allowed at the moment)
   let instances = [(cls, ts, es) | (ExprI _ (IstE cls ts es)) <- es0]
+
   -- fold the instances into the current typeclass map and return
   moduleClasses <- foldlM addInstance allClasses instances
 
@@ -548,24 +518,47 @@ findTypeclasses (ExprI moduleIndex (ModE moduleName es0)) priorClasses = do
     addInstance
       :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
       -> (Typeclass, [TypeU], [ExprI])
-      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])) 
-    addInstance clsmap (_, _, []) = return clsmap 
-    addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromList where
+      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+    addInstance clsmap (_, _, []) = return clsmap
+    addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromListWith mergeInstances where
       f :: ExprI -> MorlocMonad (EVar, (Typeclass, [TVar], EType, [TermTypes]))
       f (ExprI srcIndex (SrcE src)) =
-        case Map.lookup (srcAlias src) clsmap of 
+        case Map.lookup (srcAlias src) clsmap of
           (Just (cls1, vs, generalType, otherInstances)) -> do
             when (cls1 /= cls0) (error "Conflicting instances")
             when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
-            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (etype generalType) (zip vs ts0) }
+            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (requalify vs (etype generalType)) (zip vs ts0) }
             let newTerm = TermTypes (Just instanceType) [(moduleName, Idx srcIndex src)] []
-            let typeterms = newTerm : filter (noInstanceInLang (srcLang src)) otherInstances
-            return (srcAlias src, (cls0, vs, instanceType, typeterms))
+            let typeterms = mergeTermTypes newTerm otherInstances
+            return (srcAlias src, (cls0, vs, generalType, typeterms))
           Nothing -> error "No typeclass found for instance"
       f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
 
-      noInstanceInLang :: Lang -> TermTypes -> Bool
-      noInstanceInLang lang otherTerm = lang `notElem` (map (srcLang . val . snd) . termConcrete $ otherTerm)
+      mergeInstances
+        :: (Typeclass, [TVar], EType, [TermTypes])
+        -> (Typeclass, [TVar], EType, [TermTypes])
+        -> (Typeclass, [TVar], EType, [TermTypes])
+      mergeInstances (cls1, vs1, e1, ts1) (cls2, vs2, e2, ts2)
+        | cls1 == cls2, length vs1 == length vs2, PO.equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
+        | otherwise = error "failed to merge"
+
+      requalify :: [TVar] -> TypeU -> TypeU
+      requalify (v:vs) (ForallU v' t)
+        | v == v' = requalify vs t
+        | otherwise = ForallU v' (requalify vs t)
+      requalify _ t = t
+
+      unionTermTypes :: [TermTypes] -> [TermTypes] -> [TermTypes]
+      unionTermTypes ts1 ts2 = foldr mergeTermTypes ts2 ts1
+
+      mergeTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
+      mergeTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
+        | PO.equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
+        | otherwise = t2 : mergeTermTypes t1 ts
+      mergeTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
+        mergeTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
+      mergeTermTypes TermTypes{} (TermTypes{}:_) = error "what the why?"
+      mergeTermTypes t1 [] = [t1]
 
     linkVariablesToTypeclasses
       :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
@@ -596,12 +589,38 @@ findTypeclasses (ExprI moduleIndex (ModE moduleName es0)) priorClasses = do
       setClass :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
       setClass m termIndex v = case Map.lookup v m of
         (Just (cls, _, t, ts)) -> do
+
+          MM.sayVVV $ "setClass map:" <+> viaShow m
+
+          mapM_ mapSources ts
           s <- CMS.get
-          let newMap = GMap.insert termIndex moduleIndex (cls, t, ts) (stateTypeclassTerms s)
-          CMS.put (s { stateTypeclassTerms = newMap } )
+          -- Yes, both indices are termIndex. After typechecking, the
+          -- polymorphic type will resolve to monomorphic. Each may resolve
+          -- differently, so instances must not all point to the same signature.
+          newMap <- GMap.insertWithM mergeSignatureSet termIndex termIndex (Polymorphic cls v t ts) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap
+                     , stateName = Map.insert termIndex v (stateName s)})
           return ()
         Nothing -> return ()
-findTypeclasses _ _ = undefined 
+
+      mapSources :: TermTypes -> MorlocMonad ()
+      mapSources t = mapM_ (mapSource . snd) (termConcrete t) where
+        mapSource :: Indexed Source -> MorlocMonad ()
+        mapSource (Idx i src) = do
+          MM.sayVVV $ "mapSource" <+> pretty i <+> pretty src
+          s <- CMS.get
+          newMap <- GMap.insertWithM mergeSignatureSet i i (Monomorphic t) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap })
+          return ()
+
+      mergeSignatureSet :: SignatureSet -> SignatureSet -> MorlocMonad SignatureSet
+      mergeSignatureSet (Polymorphic cls1 v1 t1 ts1) (Polymorphic cls2 v2 t2 ts2)
+        | cls1 == cls2 && t1 == t2 && v1 == v2 = return $ Polymorphic cls1 v1 t1 (ts1 <> ts2)
+        | otherwise = error "Invalid SignatureSet merge"
+      mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> combineTermTypes ts1 ts2
+      mergeSignatureSet _ _ = undefined
+-- data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EType [TermTypes]
+findTypeclasses _ _ = undefined
 
 
 mergeTypeclasses
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index d5aabfba..fd13c558 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -19,6 +19,7 @@ import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Data.GMap as GMap
 import qualified Morloc.Monad as MM
 import qualified Morloc.TypeEval as TE
+import qualified Morloc.Frontend.PartialOrder as MTP
 
 import qualified Control.Monad.State as CMS
 import qualified Data.Map as Map
@@ -36,6 +37,10 @@ typecheck
 typecheck = mapM run where
     run :: SAnno Int Many Int -> MorlocMonad (SAnno (Indexed TypeU) Many Int)
     run e0 = do
+
+      s <- MM.gets stateSignatures
+      MM.sayVVV $ "stateSignatures:\n  " <> pretty s
+
       -- standardize names for lambda bound variables (e.g., x0, x1 ...)
       let g0 = Gamma {gammaCounter = 0, gammaContext = []}
           ((_, g1), e1) = renameSAnno (Map.empty, g0) e0
@@ -44,7 +49,13 @@ typecheck = mapM run where
       insetSay "g2:"
       seeGamma g2
       insetSay "========================================================"
-      return $ mapSAnno (fmap normalizeType) id . applyGen g2 $ e2
+      let e3 = mapSAnno (fmap normalizeType) id . applyGen g2 $ e2
+      e4 <- resolveInstances e3
+
+      s2 <- MM.gets stateSignatures
+      MM.sayVVV $ "resolved stateSignatures:\n  " <> pretty s2
+
+      return e4
 
 -- TypeU --> Type
 resolveTypes :: SAnno (Indexed TypeU) Many Int -> SAnno (Indexed Type) Many Int
@@ -52,7 +63,7 @@ resolveTypes (SAnno (Many es) (Idx i t))
   = SAnno (Many (map (first f) es)) (Idx i (typeOf t)) where
   f :: SExpr (Indexed TypeU) Many Int -> SExpr (Indexed Type) Many Int
   f (AccS x k) = AccS (resolveTypes x) k
-  f (AppS x xs) = AppS (resolveTypes x) (map resolveTypes xs) 
+  f (AppS x xs) = AppS (resolveTypes x) (map resolveTypes xs)
   f (LamS vs x) = LamS vs (resolveTypes x)
   f (LstS xs) = LstS (map resolveTypes xs)
   f (TupS xs) = TupS (map resolveTypes xs)
@@ -65,13 +76,78 @@ resolveTypes (SAnno (Many es) (Idx i t))
   f UniS = UniS
   f (VarS x) = VarS x
 
+resolveInstances :: SAnno (Indexed TypeU) Many Int -> MorlocMonad (SAnno (Indexed TypeU) Many Int)
+resolveInstances (SAnno (Many es0) (Idx gidx gtype)) = do
+  MM.sayVVV $ "resolveInstance:" <+> pretty gidx <+> "length(es0)=" <> pretty (length es0) <+> parens (pretty gtype)
+  es' <- mapM resolveExpr es0 |>> catMaybes
+  MM.sayVVV $ "resolveInstance:" <+> pretty gidx <+> "length(es')=" <> pretty (length es')
+  return $ SAnno (Many es') (Idx gidx gtype)
+  where
+  resolveExpr :: (SExpr (Indexed TypeU) Many Int, Int) -> MorlocMonad (Maybe (SExpr (Indexed TypeU) Many Int, Int))
+  -- resolve instance
+  resolveExpr e@(VarS _, i) = filterTermTypes e i
+  resolveExpr e@(CallS _, i) = filterTermTypes e i
+  -- propagate
+  resolveExpr (AccS x k, i) = do
+    x' <- resolveInstances x
+    filterTermTypes (AccS x' k, i) i
+  resolveExpr (AppS x xs, i) = do
+    x' <- resolveInstances x
+    xs' <- mapM resolveInstances xs
+    filterTermTypes (AppS x' xs', i) i
+  resolveExpr (LamS vs x, i) = do
+    x' <- resolveInstances x
+    filterTermTypes (LamS vs x', i) i
+  resolveExpr (LstS xs, i) = do
+    xs' <- mapM resolveInstances xs
+    filterTermTypes (LstS xs', i) i
+  resolveExpr (TupS xs, i) = do
+    xs' <- mapM resolveInstances xs
+    filterTermTypes (TupS xs', i) i
+  resolveExpr (NamS rs, i) = do
+    rs' <- mapM (secondM resolveInstances) rs
+    filterTermTypes (NamS rs', i) i
+  resolveExpr e@(RealS _, i) = filterTermTypes e i
+  resolveExpr e@(IntS _,  i) = filterTermTypes e i
+  resolveExpr e@(LogS _,  i) = filterTermTypes e i
+  resolveExpr e@(StrS _,  i) = filterTermTypes e i
+  resolveExpr e@(UniS,    i) = filterTermTypes e i
+
+  filterTermTypes :: e -> Int -> MorlocMonad (Maybe e)
+  filterTermTypes x i = do
+    MM.sayVVV $ "filterTermTypes:" <+> pretty i
+    s <- MM.get
+    case GMap.lookup i (stateSignatures s) of
+      (GMapJust (Polymorphic cls v gt ts)) -> do
+        MM.sayVVV $ "  polymorphic type found:" <+> pretty i <+> pretty cls <+> pretty v <+> parens (pretty gt)
+        let xs = [(etype t, map (second val) srcs) | (TermTypes (Just t) srcs _) <- ts]
+        let mostSpecificTypes = MTP.mostSpecificSubtypes gtype (map fst xs)
+        let ts' = [t | t@(TermTypes (Just et) _ _) <- ts, etype et `elem` mostSpecificTypes]
+        MM.put (s {
+          stateSignatures = GMap.insert i i (Polymorphic cls v gt ts') (stateSignatures s)
+        })
+        return $ if not (null ts')
+          then Just x
+          else Nothing
+      (GMapJust (Monomorphic (TermTypes (Just et) _ _))) -> do
+        MM.sayVVV $ "  monomorphic type found:" <+> pretty i
+                  <> "\n  gtype:" <+> pretty gtype
+                  <> "\n  etype et:" <+> pretty (etype et)
+                  <> "\n  isSubtypeOf gtype (etype et):" <+> pretty (MTP.isSubtypeOf gtype (etype et))
+        return $ if MTP.isSubtypeOf gtype (etype et)
+          then Just x
+          else Nothing
+      _ -> return (Just x)
+
+
 -- lookup a general type associated with an index
 -- standardize naming of qualifiers
 lookupType :: Int -> Gamma -> MorlocMonad (Maybe (Gamma, TypeU))
 lookupType i g = do
   m <- CMS.gets stateSignatures
   return $ case GMap.lookup i m of
-    GMapJust (TermTypes (Just (EType t _ _)) _ _) -> Just $ rename g t
+    GMapJust (Monomorphic (TermTypes (Just (EType t _ _)) _ _)) -> Just $ rename g t
+    GMapJust (Polymorphic _ _ (EType t _ _) _) -> Just $ rename g t
     _ -> Nothing
 
 -- prepare a general, indexed typechecking error
@@ -133,8 +209,8 @@ checkG
        , TypeU
        , SAnno (Indexed TypeU) Many Int
        )
-checkG g (SAnno (Many []) i) t = return (g, t, SAnno (Many []) (Idx i t)) 
-checkG g0 (SAnno (Many ((e, j):es)) i) t0 = do 
+checkG g (SAnno (Many []) i) t = return (g, t, SAnno (Many []) (Idx i t))
+checkG g0 (SAnno (Many ((e, j):es)) i) t0 = do
   (g1, t1, e') <- checkE' i g0 e t0
   (g2, t2, SAnno (Many es') idType) <- checkG' g1 (SAnno (Many es) i) t1
   return (g2, t2, SAnno (Many ((e', j):es')) idType)
@@ -202,14 +278,14 @@ synthE i g0 (AppS f xs0) = do
 
       -- extend the function type with the type of the expressions it is applied to
       (g2, funType1, inputExprs) <- application' i g1 xs0 (normalizeType funType0)
-      
+
       -- determine the type after application
       appliedType <- case funType1 of
-        (FunU ts t) -> case drop (length inputExprs) ts of 
+        (FunU ts t) -> case drop (length inputExprs) ts of
           [] -> return t -- full application
           rs -> return $ FunU rs t -- partial application
         _ -> error "impossible"
-      
+
       -- put the AppS back together with the synthesized function and input expressions
       return (g2, apply g2 appliedType, AppS (applyGen g2 funExpr0) inputExprs)
 
@@ -241,7 +317,7 @@ synthE _ g (LstS []) =
       listType = BT.listU itemType
   in return (g1, listType, LstS [])
 synthE i g (LstS (e:es)) = do
-  (g1, itemType, itemExpr) <- synthG' g e 
+  (g1, itemType, itemExpr) <- synthG' g e
   (g2, listType, listExpr) <- checkE' i g1 (LstS es) (BT.listU itemType)
   case listExpr of
     (LstS es') -> return (g2, listType, LstS (itemExpr:es'))
@@ -275,15 +351,15 @@ synthE _ g0 (NamS rs) = do
       ks = map fst rs
       (g2, t) = newvarRich [] (zip ks ts) "record_" g1
       e = NamS (zip ks es)
-  return (g2, t, e) 
+  return (g2, t, e)
 
 -- Sources are axiomatic. They are they type they are said to be.
 synthE i g (CallS src) = do
-  maybeType <- lookupType i g 
+  maybeType <- lookupType i g
   (g', t) <- case maybeType of
     Just x -> return x
     -- no, then I don't know what it is and will return an existential
-    -- if this existential is never solved, then it will become universal later 
+    -- if this existential is never solved, then it will become universal later
     Nothing -> return $ newvar "src_" g
   return (g', t, CallS src)
 
@@ -291,23 +367,23 @@ synthE i g (CallS src) = do
 -- variables should be checked against. I think (this needs formalization).
 synthE i g (VarS v) = do
   -- is this a bound variable that has already been solved
-  (g', t') <- case lookupE v g of 
+  (g', t') <- case lookupE v g of
     -- yes, return the solved type
     (Just t) -> return (g, t)
     Nothing -> do
     -- no, so is it a variable that has a type annotation?
-      maybeType <- lookupType i g 
+      maybeType <- lookupType i g
       case maybeType of
-        Just x -> return x 
+        Just x -> return x
         -- no, then I don't know what it is and will return an existential
-        -- if this existential is never solved, then it will become universal later 
+        -- if this existential is never solved, then it will become universal later
         Nothing -> return $ newvar (unEVar v <> "_u") g
   return (g', t', VarS v)
 
 
 etaExpand :: Gamma -> SAnno Int Many Int -> [SAnno Int Many Int] -> TypeU -> MorlocMonad (Maybe (Gamma, SExpr Int Many Int))
 etaExpand g0 f0 xs0@(length -> termSize) (normalizeType -> FunU (length -> typeSize) _)
-    | termSize == typeSize = return Nothing 
+    | termSize == typeSize = return Nothing
     | otherwise = Just <$> etaExpandE g0 (AppS f0 xs0)
     where
 
@@ -342,7 +418,7 @@ expand _ g x = return (g, x)
 
 applyExistential :: EVar -> SExpr Int Many Int -> MorlocMonad (SExpr Int Many Int)
 applyExistential v' (AppS f xs') = do
-    newIndex <- MM.getCounter  
+    newIndex <- MM.getCounter
     return $ AppS f (xs' <> [SAnno (Many [(VarS v', newIndex)]) newIndex])
 -- possibly illegal application, will type check after expansion
 applyExistential v' e = do
@@ -368,7 +444,7 @@ application
 --  g1 |- A->C o e =>> C -| g2
 application i g0 es0 (FunU as0 b0) = do
   (g1, as1, es1, remainder) <- zipCheck i g0 es0 as0
-  let es2 = map (applyGen g1) es1 
+  let es2 = map (applyGen g1) es1
       funType = apply g1 $ FunU (as1 <> remainder) b0
   insetSay $ "remainder:" <+> vsep (map pretty remainder)
   return (g1, funType, es2)
@@ -439,7 +515,7 @@ checkE
        , SExpr (Indexed TypeU) Many Int
        )
 checkE i g1 (LstS (e:es)) (AppU v [t]) = do
-  (g2, t2, e') <- checkG' g1 e t 
+  (g2, t2, e') <- checkG' g1 e t
   -- LstS [] will go to the normal Sub case
   (g3, t3, LstS es') <- checkE i g2 (LstS es) (AppU v [t2])
   return (g3, t3, LstS (map (applyGen g3) (e':es')))
@@ -447,14 +523,14 @@ checkE i g1 (LstS (e:es)) (AppU v [t]) = do
 checkE i g0 e0@(LamS vs body) t@(FunU as b)
     | length vs == length as = do
         let g1 = g0 ++> zipWith AnnG vs as
-        (g2, t2, e2) <- checkG' g1 body b 
+        (g2, t2, e2) <- checkG' g1 body b
 
         let t3 = apply g2 (FunU as t2)
             e3 = applyCon g2 (LamS vs e2)
 
         return (g2, t3, e3)
 
-    | otherwise = do 
+    | otherwise = do
         (g', e') <- expand (length as - length vs) g0 e0
         checkE i g' e' t
 
@@ -506,7 +582,7 @@ synthE' i g x = do
   enter "synthE"
   insetSay $ "synthesize type for: " <> peakSExpr x
   seeGamma g
-  r@(g', t, _) <- synthE i g x 
+  r@(g', t, _) <- synthE i g x
   leave "synthE"
   seeGamma g'
   insetSay $ "synthesized type = " <> pretty t
@@ -517,7 +593,7 @@ checkE' i g x t = do
   insetSay $ "check if expr: " <> peakSExpr x
   insetSay $ "matches type: " <> pretty t
   seeGamma g
-  r@(g', t', _) <- checkE i g x t 
+  r@(g', t', _) <- checkE i g x t
   leave "checkE"
   seeGamma g'
   seeType t'
diff --git a/library/Morloc/Monad.hs b/library/Morloc/Monad.hs
index 9d79dade..89d37233 100644
--- a/library/Morloc/Monad.hs
+++ b/library/Morloc/Monad.hs
@@ -35,6 +35,7 @@ module Morloc.Monad
   , setCounter
   , takeFromCounter
   -- * metadata accessors
+  , metaMonomorphicTermTypes
   , metaTermTypes
   , metaConstraints
   , metaSources
@@ -256,15 +257,26 @@ readLang langStr =
     Nothing -> throwError $ UnknownLanguage langStr
 
 
-metaTermTypes :: Int -> MorlocMonad (Maybe TermTypes)
-metaTermTypes i = do
+metaMonomorphicTermTypes :: Int -> MorlocMonad (Maybe TermTypes)
+metaMonomorphicTermTypes i = do
   s <- get
-  case GMap.lookup i (stateSignatures s) of
-    GMapNoFst -> return Nothing
-    GMapNoSnd -> throwError . CallTheMonkeys $ "Internal GMap key missing"
-    (GMapJust t) -> return (Just t)
+  return $ case GMap.lookup i (stateSignatures s) of
+    (GMapJust (Monomorphic t)) -> Just t
+    _ -> Nothing
+
 
--- | Return sources for constructing an object. These are used by `NamE NamObject` expressions.
+metaTermTypes :: Int -> MorlocMonad (Maybe [TermTypes])
+metaTermTypes i = do
+  s <- get
+  return $ case GMap.lookup i (stateSignatures s) of
+    (GMapJust (Monomorphic t)) -> Just [t]
+    (GMapJust (Polymorphic _ _ _ ts)) -> Just ts
+    _ -> Nothing
+
+-- | Return sources for constructing an object. These are used by `NamE NamObject`
+-- expressions. Sources here includes some that are not linked to signatures, such
+-- as language-specific imports of object constructors. So this supersets the
+-- stateSignatures field's sources.
 metaSources :: Int -> MorlocMonad [Source]
 metaSources i = do
   s <- gets stateSources
@@ -281,7 +293,8 @@ metaConstraints :: Int -> MorlocMonad [Constraint]
 metaConstraints i = do
   s <- gets stateSignatures 
   return $ case GMap.lookup i s of
-    (GMapJust (TermTypes (Just e) _ _)) -> Set.toList (econs e)
+    (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (econs e)
+    (GMapJust (Polymorphic _ _ e _)) -> Set.toList (econs e)
     _ -> []
 
 -- | Properties are cunrrently not used after Sanno types are created. The only
@@ -291,7 +304,8 @@ metaProperties :: Int -> MorlocMonad [Property]
 metaProperties i = do
   s <- gets stateSignatures 
   return $ case GMap.lookup i s of
-    (GMapJust (TermTypes (Just e) _ _)) -> Set.toList (eprop e)
+    (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (eprop e)
+    (GMapJust (Polymorphic _ _ e _)) -> Set.toList (eprop e)
     _ -> []
 
 -- | The name of a morloc composition. These names are stored in the monad
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index d321b5cb..9bbe3dd5 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -57,6 +57,7 @@ module Morloc.Namespace
   -- ** Morloc monad
   , MorlocMonad
   , MorlocState(..)
+  , SignatureSet(..)
   , TermTypes(..)
   , MorlocReturn
   -- ** Package metadata
@@ -145,6 +146,9 @@ type MorlocMonadGen c e l s a
 
 type MorlocReturn a = ((Either MorlocError a, [Text]), MorlocState)
 
+data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EVar EType [TermTypes]  
+  deriving(Show)
+
 data MorlocState = MorlocState
   { statePackageMeta :: [PackageMeta]
   -- ^ The parsed contents of a package.yaml file
@@ -154,8 +158,7 @@ data MorlocState = MorlocState
   -- Also used (after resetting to 0) in each of the backend generators.
   , stateDepth :: Int
   -- ^ store depth in the SAnno tree in the frontend and backend typecheckers
-  , stateSignatures :: GMap Int Int TermTypes
-  , stateTypeclassTerms :: GMap Int Int (Typeclass, EType, [TermTypes])
+  , stateSignatures :: GMap Int Int SignatureSet
   , stateConcreteTypedefs :: GMap Int MVar (Map Lang Scope)
   -- ^ stores type functions that are in scope for a given module and language
   , stateGeneralTypedefs  :: GMap Int MVar           Scope
diff --git a/library/Morloc/Pretty.hs b/library/Morloc/Pretty.hs
index fadb4821..9651f1b3 100644
--- a/library/Morloc/Pretty.hs
+++ b/library/Morloc/Pretty.hs
@@ -16,6 +16,7 @@ module Morloc.Pretty
 import Morloc.Data.Doc
 import Morloc.Namespace
 import qualified Data.Set as Set
+import qualified Data.Map as Map
 
 instance Pretty Symbol where
   pretty (TypeSymbol x) = viaShow x
@@ -38,6 +39,22 @@ instance Pretty EVar where
 instance Pretty TVar where
   pretty (TV v) = pretty v
 
+instance Pretty Typeclass where
+  pretty = pretty . unTypeclass
+
+instance (Pretty k1, Pretty k2, Pretty v) => Pretty (GMap k1 k2 v) where
+  pretty (GMap m1 m2) = "GMap" <+> (align . vsep $ [pretty (Map.toList m1), pretty (Map.toList m2)])
+
+instance Pretty SignatureSet where
+  pretty (Monomorphic t) = pretty t
+  pretty (Polymorphic cls v t ts)
+    = "class" <+> pretty cls
+    <+> (align . vsep $ (pretty v <+> "::" <+> parens (pretty t)) : map pretty ts)
+
+instance Pretty TermTypes where
+  pretty (TermTypes (Just t) cs es) = "TermTypes" <+> (align . vsep $ (parens (pretty t) : map pretty cs <> map pretty es))
+  pretty (TermTypes Nothing cs es) = "TermTypes" <+> "?" <> (align . vsep $ (map pretty cs <> map pretty es))
+
 instance Pretty Key where
   pretty (Key v) = pretty v
 
@@ -79,7 +96,7 @@ instance Pretty Type where
               (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
 
 instance Pretty EType where
-  pretty (EType t (Set.toList -> ps) (Set.toList -> cs)) = case (ps, cs) of 
+  pretty (EType t (Set.toList -> ps) (Set.toList -> cs)) = case (ps, cs) of
     ([], []) -> pretty t
     _ -> parens (psStr ps <> pretty t <> csStr cs)
     where
@@ -100,7 +117,7 @@ instance Pretty Constraint where
   pretty (Con x) = pretty x
 
 instance Pretty TypeU where
-  pretty (FunU [] t) = "() -> " <> prettyTypeU t 
+  pretty (FunU [] t) = "() -> " <> prettyTypeU t
   pretty (FunU ts t) = hsep $ punctuate " ->" (map prettyTypeU (ts <> [t]))
   pretty (ForallU _ t) = pretty t
   pretty t = prettyTypeU t
@@ -172,7 +189,7 @@ prettySExpr fc fg x0 = case x0 of
   (CallS src) -> "CallS<" <> pretty (srcName src) <> "@" <> pretty (srcLang src) <> ">"
 
 instance (Pretty k, Pretty a) => Pretty (IndexedGeneral k a) where
-  pretty (Idx i x) = parens (pretty i <> ":" <+> pretty x) 
+  pretty (Idx i x) = parens (pretty i <> ":" <+> pretty x)
 
 instance Pretty GammaIndex where
   pretty (VarG tv) = "VarG:" <+> pretty tv
@@ -186,3 +203,59 @@ instance Pretty GammaIndex where
   pretty (MarkG tv) = "MarkG:" <+> pretty tv
   pretty (SrcG (Source ev1 lang _ _ _)) = "SrcG:" <+> pretty ev1 <+> viaShow lang
   pretty (AnnG v t) = pretty v <+> "::" <+> pretty t
+
+instance Pretty ExprI where
+  pretty (ExprI i e) = parens (pretty e) <> ":" <> pretty i
+
+instance Pretty Expr where
+  pretty UniE = "()"
+  pretty (ModE v es) = align . vsep $ ("module" <+> pretty v) : map pretty es
+  pretty (ClsE cls vs sigs) = "class" <+> pretty cls <+> hsep (map pretty vs) <> (align . vsep . map pretty) sigs
+  pretty (IstE cls ts es) = "instance" <+> pretty cls <+> hsep (map (parens . pretty) ts) <> (align . vsep . map pretty) es
+  pretty (TypE lang v vs t)
+    = "type" <+> pretty lang <> "@" <> pretty v
+    <+> sep (map pretty vs) <+> "=" <+> pretty t
+  pretty (ImpE (Import m Nothing _ _)) = "import" <+> pretty m
+  pretty (ImpE (Import m (Just xs) _ _)) = "import" <+> pretty m <+> tupled (map pretty xs)
+  pretty (ExpE v) = "export" <+> pretty v
+  pretty (VarE s) = pretty s
+  pretty (AccE e k) = parens (pretty e) <> "@" <> pretty k
+  pretty (LamE v e) = "\\" <+> pretty v <+> "->" <+> pretty e
+  pretty (AnnE e ts) = parens
+    $   pretty e
+    <+> "::"
+    <+> encloseSep "(" ")" "; " (map pretty ts)
+  pretty (LstE es) = encloseSep "[" "]" "," (map pretty es)
+  pretty (TupE es) = encloseSep "[" "]" "," (map pretty es)
+  pretty (AppE f es) = vsep (map pretty (f:es))
+  pretty (NamE rs) = block 4 "<RECORD>" (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
+  pretty (RealE x) = pretty (show x)
+  pretty (IntE x) = pretty (show x)
+  pretty (StrE x) = dquotes (pretty x)
+  pretty (LogE x) = pretty x
+  pretty (AssE v e es) = pretty v <+> "=" <+> pretty e <+> "where" <+> (align . vsep . map pretty) es
+  pretty (SrcE (Source name lang file' alias label))
+    = "source"
+    <+> viaShow lang
+    <> maybe "" (\f -> "from" <+> pretty f) file'
+    <+> "("
+    <> dquotes (pretty name) <+> "as" <+>  pretty alias <> maybe "" (\s -> ":" <> pretty s) label
+    <> ")"
+  pretty (SigE (Signature v _ e)) =
+    pretty v <+> "::" <+> eprop' <> etype' <> econs'
+    where
+      eprop' :: Doc ann
+      eprop' =
+        case Set.toList (eprop e) of
+          [] -> ""
+          xs -> tupled (map pretty xs) <+> "=> "
+      etype' :: Doc ann
+      etype' = pretty (etype e)
+      econs' :: Doc ann
+      econs' =
+        case Set.toList (econs e) of
+          [] -> ""
+          xs -> " where" <+> tupled (map (\(Con x) -> pretty x) xs)
+
+instance Pretty Signature where
+  pretty (Signature v _ e) = pretty v <+> "::" <+> pretty (etype e)
diff --git a/library/Morloc/Typecheck/Internal.hs b/library/Morloc/Typecheck/Internal.hs
index 08c0d627..71c45659 100644
--- a/library/Morloc/Typecheck/Internal.hs
+++ b/library/Morloc/Typecheck/Internal.hs
@@ -74,12 +74,22 @@ class Applicable a where
 -- | Apply a context to a type (See Dunfield Figure 8).
 instance Applicable TypeU where
   -- [G]a = a
-  apply _ a@(VarU _) = a
+  apply g (VarU v) =
+    -- FIXME: very wrong - only works because of my renaming scheme
+    case lookupU v g of
+      (Just t') -> t'
+      Nothing -> VarU v
+
   -- [G](A->B) = ([G]A -> [G]B)
   apply g (FunU ts t) = FunU (map (apply g) ts) (apply g t)
   apply g (AppU t ts) = AppU (apply g t) (map (apply g) ts)
   -- [G]ForallU a.a = forall a. [G]a
-  apply g (ForallU x a) = ForallU x (apply g a)
+  apply g (ForallU v a) =
+    -- FIXME: VERY WRONG
+    case lookupU v g of 
+      (Just _) -> apply g a
+      Nothing -> ForallU v (apply g a)
+
   -- [G[a=t]]a = [G[a=t]]t
   apply g (ExistU v ts rs) =
     case lookupU v g of
diff --git a/test-suite/golden-tests/typeclasses-1/Makefile b/test-suite/golden-tests/typeclasses-1/Makefile
index a9c8990d..a9154420 100644
--- a/test-suite/golden-tests/typeclasses-1/Makefile
+++ b/test-suite/golden-tests/typeclasses-1/Makefile
@@ -1,8 +1,8 @@
 all:
 	rm -f obs.txt
 	morloc make -v main.loc > log
-	./nexus.py foo 6 5 > obs.txt
-	./nexus.py bar '"a"' '"b"' >> obs.txt
+	./nexus.py foo '"a"' '"b"' > obs.txt
+	./nexus.py bar 6 5 >> obs.txt
 
 clean:
 	rm -f nexus* pool*
diff --git a/test-suite/golden-tests/typeclasses-1/exp.txt b/test-suite/golden-tests/typeclasses-1/exp.txt
index 94ea2c9f..ea334e43 100644
--- a/test-suite/golden-tests/typeclasses-1/exp.txt
+++ b/test-suite/golden-tests/typeclasses-1/exp.txt
@@ -1,2 +1,2 @@
-17.0
 "abyolo"
+17
diff --git a/test-suite/golden-tests/typeclasses-1/foo.hpp b/test-suite/golden-tests/typeclasses-1/foo.hpp
new file mode 100644
index 00000000..30f4f978
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-1/foo.hpp
@@ -0,0 +1,18 @@
+#ifndef __FOO_HPP__
+#define __FOO_HPP__
+
+#include <string>
+
+int addInt(int x, int y){
+  return (x + y);
+}
+
+double addReal(double x, double y){
+  return (x + y);
+}
+
+std::string addStr(std::string x, std::string y){
+  return (x + y);
+}
+
+#endif
diff --git a/test-suite/golden-tests/typeclasses-1/foo.py b/test-suite/golden-tests/typeclasses-1/foo.py
new file mode 100644
index 00000000..3ab89f24
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-1/foo.py
@@ -0,0 +1,8 @@
+def addInt(x, y):
+    return x + y
+
+def addReal(x, y):
+    return x + y
+
+def addStr(x, y):
+    return x + y
diff --git a/test-suite/golden-tests/typeclasses-1/main.loc b/test-suite/golden-tests/typeclasses-1/main.loc
index ace05d88..12c91175 100644
--- a/test-suite/golden-tests/typeclasses-1/main.loc
+++ b/test-suite/golden-tests/typeclasses-1/main.loc
@@ -1,4 +1,4 @@
-module main (foo)
+module main (foo, bar)
 
 type Cpp => Int = "int"
 type Cpp => Real = "double"

From bc74e24bc8a190b770c6a75d03385aef39836b4a Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 28 Jan 2024 22:34:16 -0500
Subject: [PATCH 06/14] (1/418 fail) Fix bug in PartialOrder and add tests

A few of the `<=` signs where comparin using the default `<=` from `Ord`
rather than the partial ordered operator. This caused subtyping to be
alphabetical in some cases.
---
 library/Morloc/Frontend/PartialOrder.hs | 10 ++++----
 test-suite/UnitTypeTests.hs             | 31 ++++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/library/Morloc/Frontend/PartialOrder.hs b/library/Morloc/Frontend/PartialOrder.hs
index 0877af0d..4adab364 100644
--- a/library/Morloc/Frontend/PartialOrder.hs
+++ b/library/Morloc/Frontend/PartialOrder.hs
@@ -37,15 +37,15 @@ instance P.PartialOrd TypeU where
   (<=) (ForallU v t1) t2
     | (P.==) (ForallU v t1) t2 = True
     | otherwise = (P.<=) (substituteFirst v t1 t2) t2
-  (<=) (FunU (t11:rs1) t12) (FunU (t21:rs2) t22) = t11 <= t21 && FunU rs1 t12 <= FunU rs2 t22
-  (<=) (FunU [] t12) (FunU [] t22) = t12 <= t22 
-  (<=) (AppU t1 (t11:rs1)) (AppU t2 (t21:rs2)) = t11 <= t21 && AppU t1 rs1 <= AppU t2 rs2
-  (<=) (AppU t1 []) (AppU t2 []) = t1 <= t2
+  (<=) (FunU (t11:rs1) t12) (FunU (t21:rs2) t22) = t11 P.<= t21 && FunU rs1 t12 P.<= FunU rs2 t22
+  (<=) (FunU [] t12) (FunU [] t22) = t12 P.<= t22
+  (<=) (AppU t1 (t11:rs1)) (AppU t2 (t21:rs2)) = t11 P.<= t21 && AppU t1 rs1 P.<= AppU t2 rs2
+  (<=) (AppU t1 []) (AppU t2 []) = t1 P.<= t2
   -- the records do not need to be in the same order to be equivalent
   -- ---- do I need to sort on ps1/ps2 as well?
   (<=) (NamU o1 n1 ps1 ((k1,e1):rs1)) (NamU o2 n2 ps2 es2)
     = case DL.partition ((== k1) . fst) es2 of
-       ([(_,e2)], rs2) -> e1 <= e2 && NamU o1 n1 ps1 rs1 <= NamU o2 n2 ps2 rs2
+       ([(_,e2)], rs2) -> e1 P.<= e2 && NamU o1 n1 ps1 rs1 P.<= NamU o2 n2 ps2 rs2
        _ -> False
   (<=) (NamU o1 n1 ps1 []) (NamU o2 n2 ps2 [])
     = o1 == o2 && n1 == n2 && length ps1 == length ps2
diff --git a/test-suite/UnitTypeTests.hs b/test-suite/UnitTypeTests.hs
index fd5ae825..03ace3b9 100644
--- a/test-suite/UnitTypeTests.hs
+++ b/test-suite/UnitTypeTests.hs
@@ -570,7 +570,28 @@ orderInvarianceTests =
 typeOrderTests =
   testGroup
     "Tests of type partial ordering (subtype)"
-    [ testTrue
+    [ testFalse
+        "Str !< Real"
+        (MP.isSubtypeOf str real)
+    , testFalse
+        "Real !< Str"
+        (MP.isSubtypeOf real str)
+    , testFalse
+        "[Real] !< [Str]"
+        (MP.isSubtypeOf (lst real) (lst str))
+    , testFalse
+        "[Str] !< [Real]"
+        (MP.isSubtypeOf (lst str) (lst real))
+    , testFalse
+        "Str -> Str -> Str !< Real -> Real -> Real"
+        (MP.isSubtypeOf (fun [str, str, str]) (fun [real, real, real]))
+    , testFalse
+        "Real -> Real -> Real !< Str -> Str -> Str"
+        (MP.isSubtypeOf (fun [real, real, real]) (fun [str, str, str]))
+    , testFalse
+        "Str -> Str !< Int -> Int -> Int"
+        (MP.isSubtypeOf (fun [str, str]) (fun [int, int, int]))
+    , testTrue
         "a <: Int"
         (MP.isSubtypeOf (forall ["a"] (var "a")) int)
     , testFalse
@@ -637,6 +658,14 @@ typeOrderTests =
         "mostSpecificSubtypes: Int against [forall a . a]"
         (MP.mostSpecificSubtypes int [forall ["a"] (var "a")])
         [forall ["a"] (var "a")]
+    , testEqual
+        "mostSpecificSubtypes: (Int -> Int)"
+        (MP.mostSpecificSubtypes (fun [int, int]) [fun [str,str], fun [int, int], forall ["a"] (fun [var "a", var "a"])])
+        [fun [int, int]]
+    , testEqual
+        "mostSpecificSubtypes: empty"
+        (MP.mostSpecificSubtypes (fun [str, str, str]) [fun [real, real, real]])
+        []
 
     -- test mostSpecificSubtypes for tuples
     , testEqual

From 737201d0d03625632a147a0c220058497718541e Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 28 Jan 2024 22:38:17 -0500
Subject: [PATCH 07/14] (1/418 fail) Add handling for expressions in
 typeclasses

It doesn't work yet.
---
 library/Morloc/Frontend/Parser.hs             | 10 ++-
 library/Morloc/Frontend/Treeify.hs            | 88 ++++++++++++++-----
 library/Morloc/Frontend/Typecheck.hs          | 31 +++++--
 test-suite/Main.hs                            |  1 +
 .../golden-tests/typeclasses-2/Makefile       |  8 ++
 test-suite/golden-tests/typeclasses-2/exp.txt |  2 +
 test-suite/golden-tests/typeclasses-2/foo.hpp | 28 ++++++
 test-suite/golden-tests/typeclasses-2/foo.py  | 13 +++
 .../golden-tests/typeclasses-2/main.loc       | 40 +++++++++
 9 files changed, 189 insertions(+), 32 deletions(-)
 create mode 100644 test-suite/golden-tests/typeclasses-2/Makefile
 create mode 100644 test-suite/golden-tests/typeclasses-2/exp.txt
 create mode 100644 test-suite/golden-tests/typeclasses-2/foo.hpp
 create mode 100644 test-suite/golden-tests/typeclasses-2/foo.py
 create mode 100644 test-suite/golden-tests/typeclasses-2/main.loc

diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index a88e8f2b..198be440 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -276,9 +276,13 @@ pInstance = do
   _ <- reserved "instance"
   v <- freenameU
   ts <- many1 pType
-  srcs <- option [] (reserved "where" >> alignInset pSource) |>> concat
-  srcEs <- mapM (exprI . SrcE) srcs
-  exprI $ IstE (Typeclass v) ts srcEs
+  es <- option [] (reserved "where" >> alignInset pInstanceExpr) |>> concat
+  exprI $ IstE (Typeclass v) ts es
+  where
+    pInstanceExpr :: Parser [ExprI]
+    pInstanceExpr
+      = try (pSource >>= mapM (exprI . SrcE))
+      <|> (pAssE |>> return)
 
 pTypedef :: Parser ExprI
 pTypedef = try pTypedefType <|> pTypedefObject where
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index 5c7fd3b0..db24e369 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -337,7 +337,9 @@ collect i = do
 
 collectSAnno :: ExprI -> MorlocMonad (SAnno Int Many Int)
 collectSAnno e@(ExprI i (VarE v)) = do
+  MM.sayVVV $ "collectSAnno VarE:" <+> pretty v
   maybeTermTypes <- MM.metaTermTypes i
+  MM.sayVVV $ "maybeTermTypes:" <+> pretty maybeTermTypes
 
   es <- case maybeTermTypes of
     -- if Nothing, then the term is a bound variable
@@ -438,7 +440,7 @@ collectSExpr (ExprI i e0) = (,) <$> f e0 <*> pure i
   f ExpE{} = undefined
   f SrcE{} = undefined
   f SigE{} = undefined
-  f AssE{} = undefined
+  f (AssE v _ _) = error $ "Found AssE in collectSExpr: " <> show v 
 
 reindexExprI :: ExprI -> MorlocMonad ExprI
 reindexExprI (ExprI i e) = ExprI <$> newIndex i <*> reindexExpr e
@@ -503,6 +505,17 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
   -- fold the instances into the current typeclass map and return
   moduleClasses <- foldlM addInstance allClasses instances
 
+  MM.sayVVV $ "moduleClasses:"
+         <+> list (
+           map ( \ (v, (cls,vs,et,ts))
+                 -> pretty v <+> "="
+                 <+> pretty cls
+                 <+> pretty vs
+                 <+> parens (pretty (etype et))
+                 <+> list (map pretty ts)
+              ) (Map.toList moduleClasses)
+         )
+
   mapM_ (linkVariablesToTypeclasses moduleClasses) es0
 
   return moduleClasses
@@ -525,6 +538,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
       f (ExprI srcIndex (SrcE src)) =
         case Map.lookup (srcAlias src) clsmap of
           (Just (cls1, vs, generalType, otherInstances)) -> do
+            MM.sayVVV $ "Adding SrcE instance:" <+> pretty (srcAlias src) <+> pretty srcIndex
             when (cls1 /= cls0) (error "Conflicting instances")
             when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
             let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (requalify vs (etype generalType)) (zip vs ts0) }
@@ -532,6 +546,19 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
             let typeterms = mergeTermTypes newTerm otherInstances
             return (srcAlias src, (cls0, vs, generalType, typeterms))
           Nothing -> error "No typeclass found for instance"
+
+      f (ExprI assIdx (AssE v e _)) =
+        case Map.lookup v clsmap of
+          (Just (cls1, vs, generalType, otherInstances)) -> do
+            MM.sayVVV $ "Adding AssE instance:" <+> pretty v <+> pretty assIdx
+            when (cls1 /= cls0) (error "Conflicting instances")
+            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
+            let instanceType = generalType { etype = foldl (\t (v',r) -> substituteTVar v' r t) (requalify vs (etype generalType)) (zip vs ts0) }
+            let newTerm = TermTypes (Just instanceType) [] [e]
+            let typeterms = mergeTermTypes newTerm otherInstances
+            return (v, (cls0, vs, generalType, typeterms))
+          Nothing -> error "No typeclass found for instance"
+
       f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
 
       mergeInstances
@@ -548,18 +575,6 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
         | otherwise = ForallU v' (requalify vs t)
       requalify _ t = t
 
-      unionTermTypes :: [TermTypes] -> [TermTypes] -> [TermTypes]
-      unionTermTypes ts1 ts2 = foldr mergeTermTypes ts2 ts1
-
-      mergeTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
-      mergeTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
-        | PO.equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
-        | otherwise = t2 : mergeTermTypes t1 ts
-      mergeTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
-        mergeTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
-      mergeTermTypes TermTypes{} (TermTypes{}:_) = error "what the why?"
-      mergeTermTypes t1 [] = [t1]
-
     linkVariablesToTypeclasses
       :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
       -> ExprI
@@ -574,6 +589,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
         -- shadow all terms bound under the lambda
         let m' = foldr Map.delete m ks
         mapM_ (link m') (e:es)
+      link m (ExprI _ (AssE _ e es)) = mapM_ (link m) (e:es)
       -- modules currently cannot be nested (should this be allowed?)
       link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
       -- everything below boilerplate
@@ -592,7 +608,9 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
 
           MM.sayVVV $ "setClass map:" <+> viaShow m
 
-          mapM_ mapSources ts
+          mapM_ (mapSources cls v t) ts
+          mapM_ (mapExpressions cls v t) ts
+
           s <- CMS.get
           -- Yes, both indices are termIndex. After typechecking, the
           -- polymorphic type will resolve to monomorphic. Each may resolve
@@ -603,25 +621,53 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
           return ()
         Nothing -> return ()
 
-      mapSources :: TermTypes -> MorlocMonad ()
-      mapSources t = mapM_ (mapSource . snd) (termConcrete t) where
+      mapSources :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapSources cls v gt t = mapM_ (mapSource . snd) (termConcrete t) where
         mapSource :: Indexed Source -> MorlocMonad ()
         mapSource (Idx i src) = do
+          let t' = TermTypes (termGeneral t) [(mv, srcidx) | (mv, srcidx) <- termConcrete t, val srcidx == src] []
           MM.sayVVV $ "mapSource" <+> pretty i <+> pretty src
+                    <> "\n  termGeneral t:" <+> pretty (termGeneral t)
+                    <> "\n  termGeneral t':" <+> pretty (termGeneral t')
+                    <> "\n  length (termConcrete t):" <+> pretty (length (termConcrete t))
+                    <> "\n  length (termConcrete t'):" <+> pretty (length (termConcrete t'))
           s <- CMS.get
-          newMap <- GMap.insertWithM mergeSignatureSet i i (Monomorphic t) (stateSignatures s)
+          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap })
+          return ()
+
+      mapExpressions :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapExpressions cls v gt t = mapM_ mapExpression (termDecl t) where
+        mapExpression :: ExprI -> MorlocMonad ()
+        mapExpression (ExprI i _) = do
+          MM.sayVVV $ "mapExpression" <+> pretty i
+          s <- CMS.get
+          let t' = TermTypes (termGeneral t) [] [e | e@(ExprI i' _) <- termDecl t, i' == i]
+          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
           CMS.put (s { stateSignatures = newMap })
           return ()
 
       mergeSignatureSet :: SignatureSet -> SignatureSet -> MorlocMonad SignatureSet
       mergeSignatureSet (Polymorphic cls1 v1 t1 ts1) (Polymorphic cls2 v2 t2 ts2)
-        | cls1 == cls2 && t1 == t2 && v1 == v2 = return $ Polymorphic cls1 v1 t1 (ts1 <> ts2)
+        | cls1 == cls2 && PO.equivalent (etype t1) (etype t2) && v1 == v2 = return $ Polymorphic cls1 v1 t1 (unionTermTypes ts1 ts2)
         | otherwise = error "Invalid SignatureSet merge"
       mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> combineTermTypes ts1 ts2
       mergeSignatureSet _ _ = undefined
--- data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EType [TermTypes]
 findTypeclasses _ _ = undefined
 
+unionTermTypes :: [TermTypes] -> [TermTypes] -> [TermTypes]
+unionTermTypes ts1 ts2 = foldr mergeTermTypes ts2 ts1
+
+mergeTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
+mergeTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
+  | PO.equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
+  | otherwise = t2 : mergeTermTypes t1 ts
+mergeTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
+  mergeTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
+mergeTermTypes TermTypes{} (TermTypes{}:_) = error "what the why?"
+mergeTermTypes t1 [] = [t1]
+
+
 
 mergeTypeclasses
   :: (Typeclass, [TVar], EType, [TermTypes])
@@ -629,7 +675,7 @@ mergeTypeclasses
   -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
 mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
   | cls1 /= cls2 = error "Conflicting typeclasses"
-  | t1 /= t2 = error "Conflicting typeclass term general type"
+  | not (PO.equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
   | length vs1 /= length vs2 = error "Conflicting typeclass parameter count"
   -- here I should do reciprocal subtyping
-  | otherwise = return (cls1, vs1, t1, ts1 <> ts2)
+  | otherwise = return (cls1, vs1, t1, unionTermTypes ts1 ts2)
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index fd13c558..bfca18e8 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -119,13 +119,17 @@ resolveInstances (SAnno (Many es0) (Idx gidx gtype)) = do
     s <- MM.get
     case GMap.lookup i (stateSignatures s) of
       (GMapJust (Polymorphic cls v gt ts)) -> do
-        MM.sayVVV $ "  polymorphic type found:" <+> pretty i <+> pretty cls <+> pretty v <+> parens (pretty gt)
         let xs = [(etype t, map (second val) srcs) | (TermTypes (Just t) srcs _) <- ts]
         let mostSpecificTypes = MTP.mostSpecificSubtypes gtype (map fst xs)
         let ts' = [t | t@(TermTypes (Just et) _ _) <- ts, etype et `elem` mostSpecificTypes]
-        MM.put (s {
-          stateSignatures = GMap.insert i i (Polymorphic cls v gt ts') (stateSignatures s)
-        })
+
+        MM.sayVVV $ "  polymorphic type found:" <+> pretty i <+> pretty cls <+> pretty v <+> parens (pretty gt)
+                  <> "\n  length ts:" <+> pretty (length ts)
+                  <> "\n  gtype:" <+> pretty gtype
+                  <> "\n  (map fst xs):" <+> list (map (pretty . fst) xs)
+                  <> "\n  mostSpecificSubtypes gtype (map fst xs):" <+> list (map pretty (MTP.mostSpecificSubtypes gtype (map fst xs)))
+                  <> "\n  length ts':" <+> pretty (length ts')
+
         return $ if not (null ts')
           then Just x
           else Nothing
@@ -145,10 +149,16 @@ resolveInstances (SAnno (Many es0) (Idx gidx gtype)) = do
 lookupType :: Int -> Gamma -> MorlocMonad (Maybe (Gamma, TypeU))
 lookupType i g = do
   m <- CMS.gets stateSignatures
-  return $ case GMap.lookup i m of
-    GMapJust (Monomorphic (TermTypes (Just (EType t _ _)) _ _)) -> Just $ rename g t
-    GMapJust (Polymorphic _ _ (EType t _ _) _) -> Just $ rename g t
-    _ -> Nothing
+  case GMap.lookup i m of
+    GMapJust (Monomorphic (TermTypes (Just (EType t _ _)) _ _)) -> do
+      MM.sayVVV $ "lookupType monomorphic:" <+> pretty i <+> "found" <+> parens (pretty t)
+      return . Just $ rename g t
+    GMapJust (Polymorphic cls v (EType t _ _) _) -> do
+      MM.sayVVV $ "lookupType polymorphic:"  <+> pretty i <+> "found" <+> pretty cls <+> pretty v <+> parens (pretty t)
+      return . Just $ rename g t
+    _ -> do
+      MM.sayVVV $ "lookupType failed to find:"  <+> pretty i
+      return Nothing
 
 -- prepare a general, indexed typechecking error
 gerr :: Int -> TypeError -> MorlocMonad a
@@ -366,6 +376,8 @@ synthE i g (CallS src) = do
 -- Any morloc variables should have been expanded by treeify. Any bound
 -- variables should be checked against. I think (this needs formalization).
 synthE i g (VarS v) = do
+  MM.sayVVV $ "synthE VarS:" <+> tupled [pretty i, pretty v]
+
   -- is this a bound variable that has already been solved
   (g', t') <- case lookupE v g of
     -- yes, return the solved type
@@ -378,6 +390,9 @@ synthE i g (VarS v) = do
         -- no, then I don't know what it is and will return an existential
         -- if this existential is never solved, then it will become universal later
         Nothing -> return $ newvar (unEVar v <> "_u") g
+
+  MM.sayVVV $ "synthE VarS found type:" <+> pretty t'
+
   return (g', t', VarS v)
 
 
diff --git a/test-suite/Main.hs b/test-suite/Main.hs
index 2bfa4159..45bb1180 100644
--- a/test-suite/Main.hs
+++ b/test-suite/Main.hs
@@ -24,6 +24,7 @@ main = do
       , subtypeTests
 
       , golden "typeclasses-1" "typeclasses-1"
+      , golden "typeclasses-2" "typeclasses-2"
 
       , golden "string-encoding" "string-encoding"
 
diff --git a/test-suite/golden-tests/typeclasses-2/Makefile b/test-suite/golden-tests/typeclasses-2/Makefile
new file mode 100644
index 00000000..a9154420
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-2/Makefile
@@ -0,0 +1,8 @@
+all:
+	rm -f obs.txt
+	morloc make -v main.loc > log
+	./nexus.py foo '"a"' '"b"' > obs.txt
+	./nexus.py bar 6 5 >> obs.txt
+
+clean:
+	rm -f nexus* pool*
diff --git a/test-suite/golden-tests/typeclasses-2/exp.txt b/test-suite/golden-tests/typeclasses-2/exp.txt
new file mode 100644
index 00000000..ea334e43
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-2/exp.txt
@@ -0,0 +1,2 @@
+"abyolo"
+17
diff --git a/test-suite/golden-tests/typeclasses-2/foo.hpp b/test-suite/golden-tests/typeclasses-2/foo.hpp
new file mode 100644
index 00000000..44906c3b
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-2/foo.hpp
@@ -0,0 +1,28 @@
+#ifndef __FOO_HPP__
+#define __FOO_HPP__
+
+#include <string>
+#include <vector>
+#include <functional>
+
+int addInt(int x, int y){
+  return (x + y);
+}
+
+double addReal(double x, double y){
+  return (x + y);
+}
+
+std::string addStr(std::string x, std::string y){
+  return (x + y);
+}
+
+template <class A, class B>
+B fold(std::function<B(B,A)> f, B y, std::vector<A> xs){
+    for(std::size_t i=0; i < xs.size(); i++){
+        y = f(y, xs[i]);
+    }
+    return y;
+}
+
+#endif
diff --git a/test-suite/golden-tests/typeclasses-2/foo.py b/test-suite/golden-tests/typeclasses-2/foo.py
new file mode 100644
index 00000000..a22711d3
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-2/foo.py
@@ -0,0 +1,13 @@
+def addInt(x, y):
+    return x + y
+
+def addReal(x, y):
+    return x + y
+
+def addStr(x, y):
+    return x + y
+
+def fold(f, b, xs):
+    for x in xs:
+        b = f(b, x)
+    return b
diff --git a/test-suite/golden-tests/typeclasses-2/main.loc b/test-suite/golden-tests/typeclasses-2/main.loc
new file mode 100644
index 00000000..63fc591c
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-2/main.loc
@@ -0,0 +1,40 @@
+module main (paste, sum)
+
+type Cpp => Int = "int"
+type Cpp => Real = "double"
+type Cpp => Str = "std::string"
+type Cpp => List a = "std::vector<$1>" a
+
+type Py => Int = "int"
+type Py => Real = "float"
+type Py => Str = "str"
+type Py => List a = "list" a
+
+class Monoid a where
+  empty :: a
+  op :: a -> a -> a
+
+instance Monoid Int where
+  source Cpp from "foo.hpp" ("addInt" as op)
+  source Py from "foo.py" ("addInt" as op)
+  empty = 0
+
+instance Monoid Real where
+  source Cpp from "foo.hpp" ("addReal" as op)
+  source Py from "foo.py" ("addReal" as op)
+  empty = 0.0
+
+instance Monoid Str where
+  source Cpp from "foo.hpp" ("addStr" as op)
+  source Py from "foo.py" ("addStr" as op)
+  empty = ""
+
+source Cpp from "foo.hpp" ("fold")
+source Py from "foo.py" ("fold")
+fold :: (b -> a -> b) -> b -> [a] -> b
+
+sum :: [Real] -> Real
+sum = fold op empty
+
+paste :: [String] -> String
+paste = fold op empty

From a9c5ee4e46b64be9d53a7dd0fcb24cf68d032dfe Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 4 Feb 2024 02:22:56 -0500
Subject: [PATCH 08/14] (1/418 fail) Refactor SAnno and reimagine tree

The SAnno objects were too general. It is not true that *every* node in
the AST can have multiple implementations (or at least that each has
ambiguity. Rather, only the free variable are ambiguous. So I've moved
the One/Many functor into the free variable term (and made a separate
bound variable term). Further, I add the PolyMany functor to store
implementations before resolving typeclass polymorphisms.

I still need to resolve the current failing test and write a systematic
set of followup tests. Then I need to replace the serialization system
with a typeclass.
---
 executable/Subcommands.hs                |   6 +-
 library/Morloc.hs                        |   2 +-
 library/Morloc/CodeGenerator/Generate.hs | 807 +++++++++++------------
 library/Morloc/Frontend/AST.hs           |   6 +-
 library/Morloc/Frontend/Namespace.hs     |   4 +-
 library/Morloc/Frontend/Parser.hs        |   2 +-
 library/Morloc/Frontend/Restructure.hs   |  81 +--
 library/Morloc/Frontend/Treeify.hs       | 216 +++---
 library/Morloc/Frontend/Typecheck.hs     | 475 ++++++-------
 library/Morloc/Monad.hs                  |   1 +
 library/Morloc/Namespace.hs              | 181 +++--
 library/Morloc/Pretty.hs                 |  51 +-
 library/Morloc/Typecheck/Internal.hs     |  64 +-
 test-suite/UnitTypeTests.hs              |  10 +-
 14 files changed, 918 insertions(+), 988 deletions(-)

diff --git a/executable/Subcommands.hs b/executable/Subcommands.hs
index 01e58ae9..10479ed1 100644
--- a/executable/Subcommands.hs
+++ b/executable/Subcommands.hs
@@ -106,14 +106,14 @@ cmdTypecheck args _ config = do
                config
                (M.typecheckFrontend path code) |>> writeFrontendTypecheckOutput verbosity >>= (\s -> putDoc (s <> "\n"))
 
-writeFrontendTypecheckOutput :: Int -> ((Either MorlocError [SAnno (Indexed TypeU) Many Int], [MT.Text]), MorlocState) -> MDoc
+writeFrontendTypecheckOutput :: Int -> ((Either MorlocError [AnnoS (Indexed TypeU) Many Int], [MT.Text]), MorlocState) -> MDoc
 writeFrontendTypecheckOutput _ ((Left e, _), _) = pretty e
 writeFrontendTypecheckOutput 0 ((Right xs, _), s) = vsep (map (writeFrontendTypes s) xs)
 writeFrontendTypecheckOutput 1 ((Right xs, _), s) = "\nExports:\n\n" <> vsep (map (writeFrontendTypes s) xs)
 writeFrontendTypecheckOutput _ _ = "I don't know how to be that verbose"
 
-writeFrontendTypes :: MorlocState -> SAnno (Indexed TypeU) Many Int -> MDoc
-writeFrontendTypes  s (SAnno _ (Idx gidx t)) = writeTerm s gidx (pretty t)
+writeFrontendTypes :: MorlocState -> AnnoS (Indexed TypeU) Many Int -> MDoc
+writeFrontendTypes  s (AnnoS (Idx gidx t) _ _) = writeTerm s gidx (pretty t)
 
 writeTerm :: MorlocState -> Int -> MDoc -> MDoc
 writeTerm s i typeDoc =
diff --git a/library/Morloc.hs b/library/Morloc.hs
index 2aeeb90c..c850be01 100644
--- a/library/Morloc.hs
+++ b/library/Morloc.hs
@@ -16,7 +16,7 @@ import Morloc.Frontend.Treeify (treeify)
 typecheckFrontend
   :: Maybe Path
   -> Code
-  -> MorlocMonad [SAnno (Indexed TypeU) Many Int]
+  -> MorlocMonad [AnnoS (Indexed TypeU) Many Int]
 typecheckFrontend path code
   -- Maybe Path -> Text -> [Module]
   -- parse code into unannotated modules
diff --git a/library/Morloc/CodeGenerator/Generate.hs b/library/Morloc/CodeGenerator/Generate.hs
index c5936dec..26994bd0 100644
--- a/library/Morloc/CodeGenerator/Generate.hs
+++ b/library/Morloc/CodeGenerator/Generate.hs
@@ -8,32 +8,6 @@ Copyright   : (c) Zebulun Arendsee, 2021
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
-
-The single @generate@ function wraps the entire AST forest to source code
-translation process.
-
-The input the @generate@ is of type @[SAnno (Indexed Type) Many [Type]]@. The @SAnno
-(Indexed Type) Many [Type]@ elements each represent a single command exported from the
-main function. The @(Indexed Type)@ type stores all general information about a given
-"manifold" (a node in the function graph and all its wrappings). The term
-@Many@ states that there may be one of more AST describing each expression. The
-term @[Type]@ states that there may be multiple concrete, language-specific
-types associated with any term.
-
-The @generate@ function converts the @SAnno (Indexed Type) Many [Type]@ types into
-@SAnno (Indexed Type) One Type@ unambiguous ASTs. This step is an important
-optimization step in the morloc build pipeline. Currently the compiler uses a
-flat scoring matrix for the cost of interop between languages (e.g., 0 for C++
-to C++, 1000 for anything to R, 5 for R to R since there is a function call
-cost, etc). Replacing this algorithm with an empirically parameterized
-performance model is a major goal.
-
-Additional manipulations of the AST can reduce the number of required foreign
-calls, (de)serialization calls, and duplicate computation.
-
-The @SAnno (Indexed Type) One Type@ expression is ultimately translated into a simple
-@ExprM@ type that is then passed to a language-specific translator.
-
 -}
 
 module Morloc.CodeGenerator.Generate
@@ -44,14 +18,15 @@ module Morloc.CodeGenerator.Generate
 ) where
 
 import Morloc.CodeGenerator.Namespace
-import Morloc.Data.Doc
 import Morloc.Pretty ()
+import Morloc.Data.Doc
 import qualified Data.Map as Map
 import qualified Morloc.Config as MC
 import qualified Morloc.Data.Text as MT
 import qualified Morloc.Language as Lang
 import qualified Morloc.Monad as MM
 import qualified Morloc.CodeGenerator.Nexus as Nexus
+import Morloc.Frontend.Typecheck (peakSExpr)
 import Morloc.CodeGenerator.Infer
 
 import qualified Morloc.CodeGenerator.Grammars.Translator.Cpp as Cpp
@@ -61,10 +36,10 @@ import qualified Morloc.CodeGenerator.Serial as Serial
 
 
 realityCheck
-  :: [SAnno (Indexed Type) Many Int]
+  :: [AnnoS (Indexed Type) Many Int]
   -- ^ one AST forest for each command exported from main
-  -> MorlocMonad ( [SAnno (Indexed Type) One ()]
-                 , [SAnno (Indexed Type) One (Indexed Lang)]
+  -> MorlocMonad ( [AnnoS (Indexed Type) One ()]
+                 , [AnnoS (Indexed Type) One (Indexed Lang)]
                  )
 realityCheck es = do
 
@@ -79,8 +54,8 @@ realityCheck es = do
 
 -- | Translate typed, abstract syntax forests into compilable code
 generate
-  :: [SAnno (Indexed Type) One ()]
-  -> [SAnno (Indexed Type) One (Indexed Lang)]
+  :: [AnnoS (Indexed Type) One ()]
+  -> [AnnoS (Indexed Type) One (Indexed Lang)]
   -> MorlocMonad (Script, [Script])
   -- ^ the nexus code and the source code for each language pool
 generate gASTs rASTs = do
@@ -93,7 +68,7 @@ generate gASTs rASTs = do
   -- The call passes the pool an index for the function (manifold) that will be called.
   nexus <- Nexus.generate
     gSerial
-    [(t, i, lang) | (SAnno (One (_, Idx _ lang)) (Idx i t)) <- rASTs]
+    [(t, i, lang) | (AnnoS (Idx i t) (Idx _ lang) _) <- rASTs]
 
 
   -- initialize counter for use in express
@@ -104,8 +79,9 @@ generate gASTs rASTs = do
 
   return (nexus, pools)
 
+
 -- | Do everything except language specific code generation.
-generatePools :: [SAnno (Indexed Type) One (Indexed Lang)] -> MorlocMonad [(Lang, [SerialManifold])]
+generatePools :: [AnnoS (Indexed Type) One (Indexed Lang)] -> MorlocMonad [(Lang, [SerialManifold])]
 generatePools rASTs = do
   -- for each language, collect all functions into one "pool"
   mapM applyLambdas rASTs
@@ -132,36 +108,36 @@ generatePools rASTs = do
 -- also need benchmarking data from all the implementations and possibly
 -- statistical info describing inputs.
 realize
-  :: SAnno (Indexed Type) Many Int
-  -> MorlocMonad (Either (SAnno (Indexed Type) One ())
-                         (SAnno (Indexed Type) One (Indexed Lang)))
-realize s0 = do
-  e@(SAnno (One (_, li)) (Idx _ _)) <- scoreSAnno [] s0 >>= collapseSAnno Nothing
+  :: AnnoS (Indexed Type) Many Int
+  -> MorlocMonad (Either (AnnoS (Indexed Type) One ())
+                         (AnnoS (Indexed Type) One (Indexed Lang)))
+realize s0@(AnnoS (Idx i0 t0) _ _) = do
+  e@(AnnoS _ li _) <- scoreAnnoS [] s0 >>= collapseAnnoS Nothing |>> removeVarS
   case li of
     (Idx _ Nothing) -> makeGAST e |>> Left
     (Idx _ _) -> Right <$> propagateDown e
-  where
+  where 
 
   -- | Depth first pass calculating scores for each language. Alternates with
   -- scoresSExpr.
   --
-  scoreSAnno
+  scoreAnnoS
     :: [Lang]
-    -> SAnno (Indexed Type) Many Int
-    -> MorlocMonad (SAnno (Indexed Type) Many (Indexed [(Lang, Int)]))
-  scoreSAnno langs (SAnno (Many xs) t) = do
-    xs' <- mapM (scoreExpr langs) xs
-    return (SAnno (Many xs') t)
+    -> AnnoS (Indexed Type) Many Int
+    -> MorlocMonad (AnnoS (Indexed Type) Many (Indexed [(Lang, Int)]))
+  scoreAnnoS langs (AnnoS gi ci e) = do
+    (e', ci') <- scoreExpr langs (e, ci)
+    return $ AnnoS gi ci' e'
 
-  -- | Alternates with scoresSAnno, finds the best score for each language at
+  -- | Alternates with scoresAnnoS, finds the best score for each language at
   -- application nodes.
   scoreExpr
     :: [Lang]
-    -> (SExpr (Indexed Type) Many Int, Int)
-    -> MorlocMonad (SExpr (Indexed Type) Many (Indexed [(Lang, Int)]), Indexed [(Lang, Int)])
-  scoreExpr langs (AccS x k, i) = do
-    x' <- scoreSAnno langs x
-    return (AccS x' k, Idx i (scoresOf x'))
+    -> (ExprS (Indexed Type) Many Int, Int)
+    -> MorlocMonad (ExprS (Indexed Type) Many (Indexed [(Lang, Int)]), Indexed [(Lang, Int)])
+  scoreExpr langs (AccS k x, i) = do
+    x' <- scoreAnnoS langs x
+    return (AccS k x', Idx i (scoresOf x'))
   scoreExpr langs (LstS xs, i) = do
     (xs', best) <- scoreMany langs xs
     return (LstS xs', Idx i best)
@@ -169,26 +145,53 @@ realize s0 = do
     (xs', best) <- scoreMany langs xs
     return (TupS xs', Idx i best)
   scoreExpr langs (LamS vs x, i) = do
-    x' <- scoreSAnno langs x
+    MM.sayVVV $ "scoreExpr LamS"
+              <> "\n  langs:" <+> pretty langs
+              <> "\n  vs:" <+> pretty vs
+              <> "\n  i:" <+> pretty i
+    x' <- scoreAnnoS langs x
     return (LamS vs x', Idx i (scoresOf x'))
   scoreExpr _ (AppS f xs, i) = do
-    f' <- scoreSAnno [] f
+    MM.sayVVV $ "scoreExpr AppS"
+              <> "\n  i" <> pretty i
+    f' <- scoreAnnoS [] f
+
+    -- best scores for each language for f
     let scores = scoresOf f'
-    xs' <- mapM (scoreSAnno (unique $ map fst scores)) xs
-    -- FIXME: using an arbitrary big number as the default minimum is obviously a bad idea.
-    -- I could transform the scores such that this is a maximization problem.
-    let pairss = [(minPairs . concat) [xs''' | (_, Idx _ xs''') <- xs''] | SAnno (Many xs'') _ <- xs']
-        best = [ (l1, sum [ minimumDef 999999999 [s1 + s2 + Lang.pairwiseCost l1 l2
-                          | (l2, s2) <- pairs] | pairs <- pairss])
-               | (l1, s1) <- scores]
+
+    xs' <- mapM (scoreAnnoS (unique $ map fst scores)) xs
+
+    -- [[(Lang, Int)]] : where Lang is unique within each list and Int is minimized
+    let pairss = [minPairs xs' | AnnoS _ (Idx _ xs') _ <- xs']
+
+        {- find the best score for each language supported by function f
+          
+           Below is the cost function where
+            l1: the language of the ith calling function implementation
+            s1: the score of the ith implementation
+            l2: the language of the jth implementation of the kth argument
+            s2: the score of the jth implementation of the kth argument
+        -}
+        best = [ (l1, s1 + sum [ minimumDef 999999999 [s2 + Lang.pairwiseCost l1 l2 | (l2, s2) <- pairs]
+                               | pairs <- pairss
+                               ]
+                 )
+               | (l1, s1) <- scores
+               ]
+
     return (AppS f' xs', Idx i best)
   scoreExpr langs (NamS rs, i) = do
     (xs, best) <- scoreMany langs (map snd rs)
     return (NamS (zip (map fst rs) xs), Idx i best)
-  scoreExpr _ (CallS s, i) = return (CallS s, Idx i [(srcLang s, callCost s)])
   -- non-recursive expressions
   scoreExpr langs (UniS, i) = return (UniS, zipLang i langs)
-  scoreExpr langs (VarS v, i) = return (VarS v, zipLang i langs)
+
+  scoreExpr langs (VarS v (Many xs), i) = do
+    (xs', best) <- scoreMany langs xs
+    return (VarS v (Many xs'), Idx i best)
+
+  scoreExpr _ (CallS src, i) = return (CallS src, Idx i [(srcLang src, callCost src)])
+  scoreExpr langs (BndS v, i) = return (BndS v, zipLang i langs)
   scoreExpr langs (RealS x, i) = return (RealS x, zipLang i langs)
   scoreExpr langs (IntS x, i) = return (IntS x, zipLang i langs)
   scoreExpr langs (LogS x, i) = return (LogS x, zipLang i langs)
@@ -197,22 +200,21 @@ realize s0 = do
   zipLang :: Int -> [Lang] -> Indexed [(Lang, Int)]
   zipLang i langs = Idx i (zip langs (repeat 0))
 
-  scoresOf :: SAnno a Many (Indexed [(Lang, Int)]) -> [(Lang, Int)]
-  scoresOf (SAnno (Many xs) _) = minPairs . concat $ [xs' | (_, Idx _ xs') <- xs]
+  scoresOf :: AnnoS a Many (Indexed [(Lang, Int)]) -> [(Lang, Int)]
+  scoresOf (AnnoS _ (Idx _ xs) _) = minPairs xs
 
   -- find the scores of all implementations from all possible language contexts
   scoreMany
     :: [Lang]
-    -> [SAnno (Indexed Type) Many Int]
-    -> MorlocMonad ([SAnno (Indexed Type) Many (Indexed [(Lang, Int)])], [(Lang, Int)])
+    -> [AnnoS (Indexed Type) Many Int]
+    -> MorlocMonad ([AnnoS (Indexed Type) Many (Indexed [(Lang, Int)])], [(Lang, Int)])
   scoreMany langs xs0 = do
-    xs1 <- mapM (scoreSAnno langs) xs0
+    xs1 <- mapM (scoreAnnoS langs) xs0
     return (xs1, scoreMany' xs1)
     where
-      scoreMany' :: [SAnno (Indexed Type) Many (Indexed [(Lang, Int)])] -> [(Lang, Int)]
+      scoreMany' :: [AnnoS (Indexed Type) Many (Indexed [(Lang, Int)])] -> [(Lang, Int)]
       scoreMany' xs =
-        let pairss = [ (minPairs . concat) [xs'' | (_, Idx _ xs'') <- xs']
-                     | SAnno (Many xs') _ <- xs]
+        let pairss = [ (minPairs . concat) [xs' | (AnnoS _ (Idx _ xs') _) <- xs] ]
             langs' = unique (langs <> concatMap (map fst) pairss)
         -- Got 10 billion nodes in your AST? I didn't think so, so don't say my sentinal's ugly.
         in [(l1, sum [ minimumDef 999999999 [ score + Lang.pairwiseCost l1 l2
@@ -221,22 +223,13 @@ realize s0 = do
            | l1 <- langs']
 
 
-  collapseSAnno
+  collapseAnnoS
     :: Maybe Lang
-    -> SAnno (Indexed Type) Many (Indexed [(Lang, Int)])
-    -> MorlocMonad (SAnno (Indexed Type) One (Indexed (Maybe Lang)))
-  collapseSAnno l1 (SAnno (Many es) t@(Idx i _)) = do
-    e <- case minBy (\(_, Idx _ ss) -> minimumMay [cost l1 l2 s | (l2, s) <- ss]) es of
-      Nothing -> do
-        s <- MM.get
-        case Map.lookup i (stateName s) of
-            (Just generalName) -> MM.throwError . GeneratorError . render $
-                "No implementation found for" <+> squotes (pretty generalName)
-            Nothing -> undefined
-      (Just x@(_, Idx _ ss)) -> do
-        let newLang = fmap fst (minBy (biasedCost l1) ss)
-        collapseExpr newLang x
-    return (SAnno (One e) t)
+    -> AnnoS (Indexed Type) Many (Indexed [(Lang, Int)])
+    -> MorlocMonad (AnnoS (Indexed Type) One (Indexed (Maybe Lang)))
+  collapseAnnoS l1 (AnnoS gi ci e) = do
+    (e', ci') <- collapseExpr l1 (e, ci)
+    return (AnnoS gi ci' e')
 
   -- The biased cost adds a slight penalty to changing language.
   -- This penalty is unrelated to the often large penalty of foreign calls.
@@ -262,38 +255,56 @@ realize s0 = do
 
   collapseExpr
     :: Maybe Lang -- the language of the parent expression (if Nothing, then this is a GAST)
-    -> (SExpr (Indexed Type) Many (Indexed [(Lang, Int)]), Indexed [(Lang, Int)])
-    -> MorlocMonad (SExpr (Indexed Type) One (Indexed (Maybe Lang)), Indexed (Maybe Lang))
-  collapseExpr l1 (AccS x k, Idx i ss) = do
+    -> (ExprS (Indexed Type) Many (Indexed [(Lang, Int)]), Indexed [(Lang, Int)])
+    -> MorlocMonad (ExprS (Indexed Type) One (Indexed (Maybe Lang)), Indexed (Maybe Lang))
+
+  -- This case should be caught earlier
+  collapseExpr _ (VarS v (Many []), _)
+    = MM.throwError . GeneratorError . render
+    $ "No implementation found for" <+> squotes (pretty v)
+
+  -- Select one implementation for the given term
+  collapseExpr l1 (VarS v (Many xs), Idx i _) = do
+    let mayX = minBy (\(AnnoS _ (Idx _ ss) _) -> minimumMay [cost l1 l2 s | (l2, s) <- ss]) xs
+    (x, lang) <- case mayX of
+      Nothing -> MM.throwError . GeneratorError . render $
+                 "No implementation found for" <+> squotes (pretty v)
+      (Just x@(AnnoS _ (Idx _ ss) _)) -> do
+        let newLang = fmap fst (minBy (biasedCost l1) ss)
+        x' <- collapseAnnoS newLang x
+        return (x', newLang)
+    return (VarS v (One x), Idx i lang)
+
+  -- Propagate downwards
+  collapseExpr l1 (AccS k x, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    x' <- collapseSAnno lang x
-    return (AccS x' k, Idx i lang)
-  collapseExpr _ (CallS src, Idx i _) = do
-   return (CallS src, Idx i (Just $ srcLang src))
+    x' <- collapseAnnoS lang x
+    return (AccS k x', Idx i lang)
   collapseExpr l1 (LstS xs, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    xs' <- mapM (collapseSAnno lang) xs
+    xs' <- mapM (collapseAnnoS lang) xs
     return (LstS xs', Idx i lang)
   collapseExpr l1 (TupS xs, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    xs' <- mapM (collapseSAnno lang) xs
+    xs' <- mapM (collapseAnnoS lang) xs
     return (TupS xs', Idx i lang)
   collapseExpr l1 (LamS vs x, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    x' <- collapseSAnno lang x
+    x' <- collapseAnnoS lang x
     return (LamS vs x', Idx i lang)
   collapseExpr l1 (AppS f xs, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    f' <- collapseSAnno lang f
-    xs' <- mapM (collapseSAnno lang) xs
+    f' <- collapseAnnoS lang f
+    xs' <- mapM (collapseAnnoS lang) xs
     return (AppS f' xs', Idx i lang)
   collapseExpr l1 (NamS rs, Idx i ss) = do
     lang <- chooseLanguage l1 ss
-    xs' <- mapM (collapseSAnno lang . snd) rs
+    xs' <- mapM (collapseAnnoS lang . snd) rs
     return (NamS (zip (map fst rs) xs'), Idx i lang)
   -- collapse leaf expressions
+  collapseExpr _ (CallS src, Idx i _) = return (CallS src, Idx i (Just (srcLang src)))
+  collapseExpr lang (BndS v,   Idx i _) = return (BndS v,   Idx i lang)
   collapseExpr lang (UniS,   Idx i _) = return (UniS,   Idx i lang)
-  collapseExpr lang (VarS v, Idx i _) = return (VarS v, Idx i lang)
   collapseExpr lang (RealS x, Idx i _) = return (RealS x, Idx i lang)
   collapseExpr lang (IntS x, Idx i _) = return (IntS x, Idx i lang)
   collapseExpr lang (LogS x, Idx i _) = return (LogS x, Idx i lang)
@@ -318,29 +329,30 @@ realize s0 = do
   minPairs = map (second minimum) . groupSort
 
   propagateDown
-    ::              SAnno (Indexed Type) One (Indexed (Maybe Lang))
-    -> MorlocMonad (SAnno (Indexed Type) One (Indexed        Lang))
-  propagateDown (SAnno (One (_, Idx _ Nothing)) _) = MM.throwError . CallTheMonkeys $ "Nothing is not OK"
-  propagateDown e@(SAnno (One (_, Idx _ (Just lang0))) _) = f lang0 e where
-    f :: Lang ->     SAnno (Indexed Type) One (Indexed (Maybe Lang))
-      -> MorlocMonad (SAnno (Indexed Type) One (Indexed        Lang))
-    f lang (SAnno (One (e', Idx i Nothing)) g) = f lang (SAnno (One (e', Idx i (Just lang))) g)
-    f _ (SAnno (One (e', Idx i (Just lang))) g) = do
+    ::              AnnoS (Indexed Type) One (Indexed (Maybe Lang))
+    -> MorlocMonad (AnnoS (Indexed Type) One (Indexed        Lang))
+  propagateDown (AnnoS _ (Idx _ Nothing) _) = MM.throwError . CallTheMonkeys $ "Nothing is not OK"
+  propagateDown e@(AnnoS _ (Idx _ (Just lang0)) _) = f lang0 e where
+    f :: Lang ->     AnnoS (Indexed Type) One (Indexed (Maybe Lang))
+      -> MorlocMonad (AnnoS (Indexed Type) One (Indexed        Lang))
+    f lang (AnnoS g (Idx i Nothing) e') = f lang (AnnoS g (Idx i (Just lang)) e')
+    f _ (AnnoS g (Idx i (Just lang)) e') = do
       e'' <- case e' of
-        (AccS x k) -> AccS <$> f lang x <*> pure k
+        (AccS k x) -> AccS k <$> f lang x
         (AppS x xs) -> AppS <$> f lang x <*> mapM (f lang) xs
         (LamS vs x) -> LamS vs <$> f lang x
         (LstS xs) -> LstS <$> mapM (f lang) xs
         (TupS xs) -> TupS <$> mapM (f lang) xs
         (NamS rs) -> NamS <$> (zip (map fst rs) <$> mapM (f lang . snd) rs)
         UniS -> return UniS
-        (VarS x) -> return (VarS x)
+        (VarS v (One x)) -> VarS v . One <$> f lang x
+        (BndS v) -> return (BndS v)
         (RealS x) -> return (RealS x)
         (IntS x) -> return (IntS x)
         (LogS x) -> return (LogS x)
         (StrS x) -> return (StrS x)
         (CallS x) -> return (CallS x)
-      return (SAnno (One (e'', Idx i lang)) g)
+      return (AnnoS g (Idx i lang) e'')
 
 -- | This function is called on trees that contain no language-specific
 -- components.  "GAST" refers to General Abstract Syntax Tree. The most common
@@ -362,12 +374,22 @@ realize s0 = do
 --  f6 (x,y) = (y,x)
 --
 -- The idea could be elaborated into a full-fledged language.
-makeGAST :: SAnno (Indexed Type) One (Indexed (Maybe Lang)) -> MorlocMonad (SAnno (Indexed Type) One ())
-makeGAST = mapCM (\(Idx _ _) -> return ())
-
-
-generalSerial :: SAnno (Indexed Type) One () -> MorlocMonad NexusCommand
-generalSerial x0@(SAnno _ (Idx i t)) = do
+makeGAST :: AnnoS (Indexed Type) One (Indexed (Maybe Lang)) -> MorlocMonad (AnnoS (Indexed Type) One ())
+makeGAST = mapAnnoSCM (\(Idx _ _) -> return ())
+
+removeVarS :: AnnoS g One c -> AnnoS g One c
+removeVarS (AnnoS g1 _ (VarS _ (One (AnnoS _ c2 x)))) = removeVarS (AnnoS g1 c2 x)
+removeVarS (AnnoS g c (AccS k x)) = AnnoS g c (AccS k (removeVarS x))
+removeVarS (AnnoS g c (AppS x xs)) = AnnoS g c (AppS (removeVarS x) (map removeVarS xs))
+removeVarS (AnnoS g c (LamS vs x )) = AnnoS g c (LamS vs (removeVarS x))
+removeVarS (AnnoS g c (LstS xs)) = AnnoS g c (LstS (map removeVarS xs))
+removeVarS (AnnoS g c (TupS xs)) = AnnoS g c (TupS (map removeVarS xs))
+removeVarS (AnnoS g c (NamS rs)) = AnnoS g c (NamS (map (second removeVarS) rs))
+removeVarS x = x
+
+
+generalSerial :: AnnoS (Indexed Type) One () -> MorlocMonad NexusCommand
+generalSerial x0@(AnnoS (Idx i t) _ _) = do
   mayName <- MM.metaName i
   n <- case mayName of
     Nothing -> MM.throwError . OtherError $ "No general type found for call-free function"
@@ -384,20 +406,20 @@ generalSerial x0@(SAnno _ (Idx i t)) = do
     }
   generalSerial' base [] x0
   where
-    generalSerial' :: NexusCommand -> JsonPath -> SAnno (Indexed Type) One () -> MorlocMonad NexusCommand
-    generalSerial' base _ (SAnno (One (UniS,   _)) _)
+    generalSerial' :: NexusCommand -> JsonPath -> AnnoS (Indexed Type) One () -> MorlocMonad NexusCommand
+    generalSerial' base _ (AnnoS _ _ UniS)
       = return $ base { commandJson = "null" }
-    generalSerial' base _ (SAnno (One (RealS x, _)) _)
+    generalSerial' base _ (AnnoS _ _ (RealS x))
       = return $ base { commandJson = viaShow x }
-    generalSerial' base _ (SAnno (One (IntS x, _)) _)
+    generalSerial' base _ (AnnoS _ _ (IntS x))
       = return $ base { commandJson = viaShow x }
-    generalSerial' base _ (SAnno (One (LogS x, _)) _)
+    generalSerial' base _ (AnnoS _ _ (LogS x))
       = return $ base { commandJson = if x then "true" else "false" }
-    generalSerial' base _ (SAnno (One (StrS x, _)) _)
+    generalSerial' base _ (AnnoS _ _ (StrS x))
       = return $ base { commandJson = dquotes (pretty x) }
     -- if a nested accessor is observed, evaluate the nested expression and
     -- append the path
-    generalSerial' base ps (SAnno (One (AccS x@(SAnno (One (AccS _ _, _)) _) k, _)) _) = do
+    generalSerial' base ps (AnnoS _ _ (AccS k x@(AnnoS _ _ (AccS _ _)))) = do
       ncmd <- generalSerial' base ps x
       case commandSubs ncmd of
         [(ps1, arg, ps2)] ->
@@ -405,28 +427,28 @@ generalSerial x0@(SAnno _ (Idx i t)) = do
         _ -> error "Bad record access"
     -- record the path to and from a record access, leave the value as null, it
     -- will be set in the nexus
-    generalSerial' base ps (SAnno (One (AccS (SAnno (One (VarS v, _)) (Idx _ NamT {})) k, _)) _) =
+    generalSerial' base ps (AnnoS _ _ (AccS k (AnnoS (Idx _ NamT {}) _ (BndS v)))) =
       return $ base { commandSubs = [(ps, unEVar v, [JsonKey k])] }
     -- If the accessed type is not a record, try to simplify the type
-    generalSerial' base ps (SAnno (One (AccS (SAnno x1 (Idx m t')) x2, x3)) x4) = do
-      mayT <- evalGeneralStep i (type2typeu t')
+    generalSerial' base ps (AnnoS g1 c1 (AccS key (AnnoS (Idx m oldType) c2 x))) = do
+      mayT <- evalGeneralStep i (type2typeu oldType)
       case mayT of
-        (Just t'') -> generalSerial' base ps (SAnno (One (AccS (SAnno x1 (Idx m (typeOf t''))) x2, x3)) x4)
-        Nothing -> MM.throwError . OtherError . render $ "Non-record access of type:" <+> pretty t'
-
-    generalSerial' base ps (SAnno (One (LstS xs, _)) _) = do
+        (Just recordType) ->
+          generalSerial' base ps (AnnoS g1 c1 (AccS key (AnnoS (Idx m (typeOf recordType)) c2 x)))
+        Nothing -> MM.throwError . OtherError . render $ "Non-record access of type:" <+> pretty oldType
+    generalSerial' base ps (AnnoS _ _ (LstS xs)) = do
       ncmds <- zipWithM (generalSerial' base) [ps ++ [JsonIndex j] | j <- [0..]] xs
       return $ base
         { commandJson = list (map commandJson ncmds)
         , commandSubs = concatMap commandSubs ncmds
         }
-    generalSerial' base ps (SAnno (One (TupS xs, _)) _) = do
+    generalSerial' base ps (AnnoS _ _ (TupS xs)) = do
       ncmds <- zipWithM (generalSerial' base) [ps ++ [JsonIndex j] | j <- [0..]] xs
       return $ base
         { commandJson = list (map commandJson ncmds)
         , commandSubs = concatMap commandSubs ncmds
         }
-    generalSerial' base ps (SAnno (One (NamS es, _)) _) = do
+    generalSerial' base ps (AnnoS _ _ (NamS es)) = do
       ncmds <- fromJust <$>
         safeZipWithM
           (generalSerial' base)
@@ -439,246 +461,256 @@ generalSerial x0@(SAnno _ (Idx i t)) = do
         { commandJson = obj
         , commandSubs = concatMap commandSubs ncmds
         }
-    generalSerial' base ps (SAnno (One (LamS vs x, _)) _) = do
+    generalSerial' base ps (AnnoS _ _ (LamS vs x)) = do
       ncmd <- generalSerial' base ps x
       return $ ncmd { commandArgs = vs }
-    generalSerial' base ps (SAnno (One (VarS (EV v), _)) _) =
+    generalSerial' base ps (AnnoS _ _(BndS (EV v))) =
       return $ base { commandSubs = [(ps, v, [])] }
     -- bad states
-    generalSerial' NexusCommand{} _ (SAnno (One (AppS _ _, ())) _) = error "Functions should not occur here, observed AppS"
-    generalSerial' NexusCommand{} _ (SAnno (One (CallS _, ())) _) = error "Functions should not occur here, observed CallS"
-
-
-{- | Remove lambdas introduced through substitution
-
-For example:
-
- bif x = add x 10
- bar py :: "int" -> "int"
- bar y = add y 30
- f z = bar (bif z)
-
-In Treeify.hs, the morloc declarations will be substituted in as lambdas. But
-we want to preserve the link to any annotations (in this case, the annotation
-that `bar` should be in terms of python ints). The morloc declarations can be
-substituted in as follows:
-
- f z = (\y -> add y 30) ((\x -> add x 10) z)
-
-The indices for bif and bar that link the annotations to the functions are
-relative to the lambda expressions, so this substitution preserves the link.
-Typechecking can proceed safely.
-
-The expression can be simplified:
-
- f z = (\y -> add y 30) ((\x -> add x 10) z)
- f z = (\y -> add y 30) (add z 10)            -- [z / x]
- f z = add (add z 10) 30                      -- [add z 10 / y]
-
-The simplified expression is what should be written in the generated code. It
-would also be easier to typecheck and debug. So should these substitutions be
-done immediately after parsing? We need to preserve
- 1. links to locations in the original source code (for error messages)
- 2. type annotations.
- 3. declaration names for generated comments and subcommands
-
-Here is the original expression again, but annotated and indexed
-
- (\x -> add_2 x_3 10_4)_1
- (\y -> add_6 y_7 30_8)_5
- (\z -> bar_10 (bif_11 z_12))_9
-
- 1: name="bif"
- 5: name="bar", type="int"@py -> "int"@py
- 9: name="f"
-
-Each add is also associated with a type defined in a signature in an
-unmentioned imported library, but those will be looked up by the typechecker
-and will not be affected by rewriting.
-
-Substitution requires reindexing. A definition can be used multiple times and
-we need to distinguish between the use cases.
-
-Replace bif and bar with their definition and create fresh indices:
-
- (\z -> (\y -> add_18 y_19 30_20)_17 ((\x -> add_14 x_15 10_16)_13 z_12)_9
-
- 13,1: name="bif"
- 17,5: name="bar", type="int"@py -> "int"@py
- 9: name="f"
-
-Now we can substitute for y
-
- (\z -> add_18 ((\x -> add_14 x_15 10_16)_13 z_12)_9 30_20)
+    generalSerial' _ _ (AnnoS _ _ (VarS v _)) = error $ "VarS should have been removed in the prior step, found: " <> show v 
+    generalSerial' NexusCommand{} _ (AnnoS _ _ (CallS _)) = error "Functions should not occur here, observed AppS"
+    generalSerial' NexusCommand{} _ (AnnoS _ _ (AppS _ _)) = error "Functions should not occur here, observed AppS"
 
-But this destroyed index 17 and the link to the python annotation. We can
-preserve the type by splitting the annotation of bar.
 
- 13,1: name="bif"
- 18,17,5: name="bar"
- 12: "int"@py
- 13: "int"@py
- 9: name="f"
-
-Index 18 should be associated with the *name* "bar", but not the type, since it
-has been applied. The type of bar is now split between indices 12 and 13.
-
-This case works fine, but it breaks down when types are polymorphic. If the
-annotation of bar had been `a -> a`, then how would we type 12 and 13? We can't
-say that `12 :: forall a . a` and `13 :: forall a . a`, since this
-eliminates the constraint that the `a`s must be the same.
-
-If instead we rewrite lambdas after typechecking, then everything works out.
-
-Thus applyLambdas is done here, rather than in Treeify.hs or Desugar.hs.
-
-It also must be done BEFORE conversion to ExprM in `express`, where manifolds
-are resolved.
--}
+-- {- | Remove lambdas introduced through substitution
+--
+-- For example:
+--
+--  bif x = add x 10
+--  bar py :: "int" -> "int"
+--  bar y = add y 30
+--  f z = bar (bif z)
+--
+-- In Treeify.hs, the morloc declarations will be substituted in as lambdas. But
+-- we want to preserve the link to any annotations (in this case, the annotation
+-- that `bar` should be in terms of python ints). The morloc declarations can be
+-- substituted in as follows:
+--
+--  f z = (\y -> add y 30) ((\x -> add x 10) z)
+--
+-- The indices for bif and bar that link the annotations to the functions are
+-- relative to the lambda expressions, so this substitution preserves the link.
+-- Typechecking can proceed safely.
+--
+-- The expression can be simplified:
+--
+--  f z = (\y -> add y 30) ((\x -> add x 10) z)
+--  f z = (\y -> add y 30) (add z 10)            -- [z / x]
+--  f z = add (add z 10) 30                      -- [add z 10 / y]
+--
+-- The simplified expression is what should be written in the generated code. It
+-- would also be easier to typecheck and debug. So should these substitutions be
+-- done immediately after parsing? We need to preserve
+--  1. links to locations in the original source code (for error messages)
+--  2. type annotations.
+--  3. declaration names for generated comments and subcommands
+--
+-- Here is the original expression again, but annotated and indexed
+--
+--  (\x -> add_2 x_3 10_4)_1
+--  (\y -> add_6 y_7 30_8)_5
+--  (\z -> bar_10 (bif_11 z_12))_9
+--
+--  1: name="bif"
+--  5: name="bar", type="int"@py -> "int"@py
+--  9: name="f"
+--
+-- Each add is also associated with a type defined in a signature in an
+-- unmentioned imported library, but those will be looked up by the typechecker
+-- and will not be affected by rewriting.
+--
+-- Substitution requires reindexing. A definition can be used multiple times and
+-- we need to distinguish between the use cases.
+--
+-- Replace bif and bar with their definition and create fresh indices:
+--
+--  (\z -> (\y -> add_18 y_19 30_20)_17 ((\x -> add_14 x_15 10_16)_13 z_12)_9
+--
+--  13,1: name="bif"
+--  17,5: name="bar", type="int"@py -> "int"@py
+--  9: name="f"
+--
+-- Now we can substitute for y
+--
+--  (\z -> add_18 ((\x -> add_14 x_15 10_16)_13 z_12)_9 30_20)
+--
+-- But this destroyed index 17 and the link to the python annotation. We can
+-- preserve the type by splitting the annotation of bar.
+--
+--  13,1: name="bif"
+--  18,17,5: name="bar"
+--  12: "int"@py
+--  13: "int"@py
+--  9: name="f"
+--
+-- Index 18 should be associated with the *name* "bar", but not the type, since it
+-- has been applied. The type of bar is now split between indices 12 and 13.
+--
+-- This case works fine, but it breaks down when types are polymorphic. If the
+-- annotation of bar had been `a -> a`, then how would we type 12 and 13? We can't
+-- say that `12 :: forall a . a` and `13 :: forall a . a`, since this
+-- eliminates the constraint that the `a`s must be the same.
+--
+-- If instead we rewrite lambdas after typechecking, then everything works out.
+--
+-- Thus applyLambdas is done here, rather than in Treeify.hs or Desugar.hs.
+--
+-- It also must be done BEFORE conversion to ExprM in `express`, where manifolds
+-- are resolved.
+-- -}
 applyLambdas
-  :: SAnno (Indexed Type) One (Indexed Lang)
-  -> MorlocMonad (SAnno (Indexed Type) One (Indexed Lang))
+  :: AnnoS (Indexed Type) One (Indexed Lang)
+  -> MorlocMonad (AnnoS (Indexed Type) One (Indexed Lang))
 -- eliminate empty lambdas
-applyLambdas (SAnno (One (AppS ( SAnno (One (LamS [] (SAnno e _), _)) _) [], _)) i) = applyLambdas $ SAnno e i
+applyLambdas (AnnoS g1 _ (AppS (AnnoS _ _ (LamS [] (AnnoS _ c2 e))) [])) = applyLambdas $ AnnoS g1 c2 e
 
 -- eliminate empty applications
-applyLambdas (SAnno (One (AppS (SAnno e _) [], _)) i) = applyLambdas $ SAnno e i
+applyLambdas (AnnoS g1 _ (AppS (AnnoS _ c2 e) [])) = applyLambdas $ AnnoS g1 c2 e
 
 -- substitute applied lambdas
-applyLambdas (SAnno (One (AppS (SAnno (One (LamS (v:vs) e2, Idx j2 lang)) (Idx i2 (FunT (_:tas) tb2))) (e1:es), tb1)) i1) = do
-  let e2' = substituteSAnno v e1 e2
-  applyLambdas (SAnno (One (AppS (SAnno (One (LamS vs e2', Idx j2 lang)) (Idx i2 (FunT tas tb2))) es, tb1)) i1)
+applyLambdas 
+  (AnnoS i1 tb1
+    ( AppS
+      ( AnnoS
+          (Idx i2 (FunT (_:tas) tb2))
+          (Idx j2 lang)
+          (LamS (v:vs) e2)
+      )
+      ( e1:es )
+    )
+  ) = let e2' = substituteAnnoS v e1 e2
+      in applyLambdas
+          (AnnoS i1 tb1
+            ( AppS
+              ( AnnoS
+                  (Idx i2 (FunT tas tb2))
+                  (Idx j2 lang)
+                  (LamS vs e2')
+              )
+              es
+            )
+          )
 
 -- propagate the changes
-applyLambdas (SAnno (One (AppS f es, c)) g) = do
+applyLambdas (AnnoS g c (AppS f es)) = do
   f' <- applyLambdas f
   es' <- mapM applyLambdas es
-  return (SAnno (One (AppS f' es', c)) g)
-applyLambdas (SAnno (One (AccS e k, c)) g) = do
-  e' <- applyLambdas e
-  return (SAnno (One (AccS e' k, c)) g)
-applyLambdas (SAnno (One (LamS vs e, c)) g) = do
-  e' <- applyLambdas e
-  return (SAnno (One (LamS vs e', c)) g)
-applyLambdas (SAnno (One (LstS es, c)) g) = do
-  es' <- mapM applyLambdas es
-  return (SAnno (One (LstS es', c)) g)
-applyLambdas (SAnno (One (TupS es, c)) g) = do
-  es' <- mapM applyLambdas es
-  return (SAnno (One (TupS es', c)) g)
-applyLambdas (SAnno (One (NamS rs, c)) g) = do
-  es' <- mapM (applyLambdas . snd) rs
-  return (SAnno (One (NamS (zip (map fst rs) es'), c)) g)
+  return (AnnoS g c (AppS f' es'))
+applyLambdas (AnnoS g c (AccS k e)) = AnnoS g c . AccS k <$> applyLambdas e
+applyLambdas (AnnoS g c (LamS vs e)) = AnnoS g c . LamS vs <$> applyLambdas e
+applyLambdas (AnnoS g c (LstS es)) = AnnoS g c . LstS <$> mapM applyLambdas es
+applyLambdas (AnnoS g c (TupS es)) = AnnoS g c . TupS <$> mapM applyLambdas es
+applyLambdas (AnnoS g c (NamS rs)) = AnnoS g c . NamS <$> mapM (secondM applyLambdas) rs
+applyLambdas (AnnoS g c (VarS v (One e))) = AnnoS g c . VarS v . One <$> applyLambdas e
 applyLambdas x = return x
 
-substituteSAnno
+substituteAnnoS
   :: EVar
-  -> SAnno (Indexed Type) One (Indexed Lang)
-  -> SAnno (Indexed Type) One (Indexed Lang)
-  -> SAnno (Indexed Type) One (Indexed Lang)
-substituteSAnno v r = f where
-  f e@(SAnno (One (VarS v', _)) _)
+  -> AnnoS (Indexed Type) One (Indexed Lang)
+  -> AnnoS (Indexed Type) One (Indexed Lang)
+  -> AnnoS (Indexed Type) One (Indexed Lang)
+substituteAnnoS v r = f where
+  f e@(AnnoS _ _ (BndS v'))
     | v == v' = r
     | otherwise = e
   -- propagate the changes
-  f (SAnno (One (AppS e es, c)) g) =
+  f (AnnoS g c (AppS e es)) =
     let f' = f e
         es' = map f es
-    in SAnno (One (AppS f' es', c)) g
-  f (SAnno (One (AccS e k, c)) g) =
+    in AnnoS g c (AppS f' es')
+  f (AnnoS g c (AccS k e)) =
     let e' = f e
-    in SAnno (One (AccS e' k, c)) g
-  f (SAnno (One (LamS vs e, c)) g) =
+    in AnnoS g c (AccS k e')
+  f (AnnoS g c (LamS vs e)) =
     let e' = f e
-    in SAnno (One (LamS vs e', c)) g
-  f (SAnno (One (LstS es, c)) g) =
+    in AnnoS g c (LamS vs e')
+  f (AnnoS g c (LstS es)) =
     let es' = map f es
-    in SAnno (One (LstS es', c)) g
-  f (SAnno (One (TupS es, c)) g) =
+    in AnnoS g c (LstS es')
+  f (AnnoS g c (TupS es)) =
     let es' = map f es
-    in SAnno (One (TupS es', c)) g
-  f (SAnno (One (NamS rs, c)) g) =
+    in AnnoS g c (TupS es')
+  f (AnnoS g c (NamS rs)) =
     let es' = map (f . snd) rs
-    in SAnno (One (NamS (zip (map fst rs) es'), c)) g
+    in AnnoS g c (NamS (zip (map fst rs) es'))
   f x = x
 
+
 -- | Add arguments that are required for each term. Unneeded arguments are
 -- removed at each step.
 parameterize
-  :: SAnno (Indexed Type) One (Indexed Lang)
-  -> MorlocMonad (SAnno (Indexed Type) One (Indexed Lang, [Arg EVar]))
-parameterize (SAnno (One (LamS vs x, c)) m@(Idx _ (FunT inputs _))) = do
+  :: AnnoS (Indexed Type) One (Indexed Lang)
+  -> MorlocMonad (AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]))
+parameterize (AnnoS m@(Idx _ (FunT inputs _)) c (LamS vs x)) = do
   MM.sayVVV "Entering parameterize LamS"
   ids <- MM.takeFromCounter (length inputs)
   let args0 = fromJust $ safeZipWith Arg ids vs
   x' <- parameterize' args0 x
-  return $ SAnno (One (LamS vs x', (c, args0))) m
-parameterize (SAnno (One (CallS src, c)) m@(Idx _ (FunT inputs _))) = do
-  MM.sayVVV $ "Entering parameterize CallS - " <> pretty (srcName src) <> "@" <> pretty (srcLang src)
+  return $ AnnoS m (c, args0) (LamS vs x')
+parameterize (AnnoS m@(Idx _ (FunT inputs _)) c@(Idx _ lang) (BndS v)) = do
+  MM.sayVVV $ "Entering parameterize VarS function - " <> pretty v <> "@" <> pretty lang
   ids <- MM.takeFromCounter (length inputs)
   let vs = map EV (freshVarsAZ [])
       args0 = fromJust $ safeZipWith Arg ids vs
-  return $ SAnno (One (CallS src, (c, args0))) m
+  return $ AnnoS m (c, args0) (BndS v)
 parameterize x = do
   MM.sayVVV "Entering parameterize Other"
   parameterize' [] x
 
 parameterize'
   :: [Arg EVar] -- arguments in parental scope (child needn't retain them)
-  -> SAnno (Indexed Type) One (Indexed Lang)
-  -> MorlocMonad (SAnno (Indexed Type) One (Indexed Lang, [Arg EVar]))
+  -> AnnoS (Indexed Type) One (Indexed Lang)
+  -> MorlocMonad (AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]))
 -- primitives, no arguments are required for a primitive, so empty lists
-parameterize' _ (SAnno (One (UniS, c)) m) = return $ SAnno (One (UniS, (c, []))) m
-parameterize' _ (SAnno (One (RealS x, c)) m) = return $ SAnno (One (RealS x, (c, []))) m
-parameterize' _ (SAnno (One (IntS x, c)) m) = return $ SAnno (One (IntS x, (c, []))) m
-parameterize' _ (SAnno (One (LogS x, c)) m) = return $ SAnno (One (LogS x, (c, []))) m
-parameterize' _ (SAnno (One (StrS x, c)) m) = return $ SAnno (One (StrS x, (c, []))) m
-parameterize' args (SAnno (One (VarS v, c)) m) = do
+parameterize' _ (AnnoS g c UniS) = return $ AnnoS g (c, []) UniS
+parameterize' _ (AnnoS g c (RealS x)) = return (AnnoS g (c, []) (RealS x))
+parameterize' _ (AnnoS g c (IntS x))  = return (AnnoS g (c, []) (IntS x)) 
+parameterize' _ (AnnoS g c (LogS x))  = return (AnnoS g (c, []) (LogS x)) 
+parameterize' _ (AnnoS g c (StrS x))  = return (AnnoS g (c, []) (StrS x)) 
+parameterize' args (AnnoS g c (BndS v)) = do
   let args' = [r | r@(Arg _ v') <- args, v' == v]
-  MM.sayVVV $ "In parameterize' for m" <> pretty m
-  MM.sayVVV $ "  v:" <+> pretty v
-  MM.sayVVV $ "  c:" <+> pretty c
-  return $ SAnno (One (VarS v, (c, args'))) m
-parameterize' _ (SAnno (One (CallS src, c)) m) = do
-  return $ SAnno (One (CallS src, (c, []))) m
-parameterize' args (SAnno (One (AccS x k, c)) m) = do
+  return $ AnnoS g (c, args') (BndS v)
+parameterize' args (AnnoS g c (AccS k x)) = do
   x' <- parameterize' args x
   let args' = pruneArgs args [x']
-  return $ SAnno (One (AccS x' k, (c, args'))) m
-parameterize' args (SAnno (One (LstS xs, c)) m) = do
+  return $ AnnoS g (c, args') (AccS k x')
+parameterize' _ (AnnoS m c (CallS src)) = do
+  return $ AnnoS m (c, []) (CallS src)
+parameterize' args (AnnoS g c (LstS xs)) = do
   xs' <- mapM (parameterize' args) xs
   let args' = pruneArgs args xs'
-  return $ SAnno (One (LstS xs', (c, args'))) m
-parameterize' args (SAnno (One (TupS xs, c)) m) = do
+  return $ AnnoS g (c, args') (LstS xs')
+parameterize' args (AnnoS g c (TupS xs)) = do
   xs' <- mapM (parameterize' args) xs
   let args' = pruneArgs args xs'
-  return $ SAnno (One (TupS xs', (c, args'))) m
-parameterize' args (SAnno (One (NamS entries, c)) m) = do
+  return $ AnnoS g (c, args') (TupS xs')
+parameterize' args (AnnoS g c (NamS entries)) = do
   xs' <- mapM (parameterize' args . snd) entries
   let args' = pruneArgs args xs'
-  return $ SAnno (One (NamS (zip (map fst entries) xs'), (c, args'))) m
-parameterize' args (SAnno (One (LamS vs x, c)) m@(Idx _ (FunT inputs _))) = do
+  return $ AnnoS g (c, args') (NamS (zip (map fst entries) xs'))
+parameterize' args (AnnoS g@(Idx _ (FunT inputs _)) c (LamS vs x)) = do
   ids <- MM.takeFromCounter (length inputs)
   let contextArgs = [r | r@(Arg _ v) <- args, v `notElem` vs] -- remove shadowed arguments
       boundArgs = fromJust $ safeZipWith Arg ids vs
   x' <- parameterize' (contextArgs <> boundArgs) x
   let contextArgs' = pruneArgs contextArgs [x']
-  return $ SAnno (One (LamS vs x', (c, contextArgs' <> boundArgs))) m
+  return $ AnnoS g (c, contextArgs' <> boundArgs) (LamS vs x')
 -- LamS MUST have a functional type, deviations would have been caught by the typechecker
-parameterize' _ (SAnno (One (LamS _ _, _)) _) = error "impossible"
-parameterize' args (SAnno (One (AppS x xs, c)) m) = do
+parameterize' _ (AnnoS _ _ (LamS _ _)) = error "impossible"
+parameterize' args (AnnoS g c (AppS x xs)) = do
   x' <- parameterize' args x
   xs' <- mapM (parameterize' args) xs
   let args' = pruneArgs args (x':xs')
-  return $ SAnno (One (AppS x' xs', (c, args'))) m
+  return $ AnnoS g (c, args') (AppS x' xs')
+parameterize' _ (AnnoS _ _ (VarS _ _)) = undefined
 
-pruneArgs :: [Arg a] -> [SAnno c One (g, [Arg a])] -> [Arg a]
-pruneArgs args xs = 
+pruneArgs :: [Arg a] -> [AnnoS c One (g, [Arg a])] -> [Arg a]
+pruneArgs args xs =
   let usedArgs = unique $ concatMap (map ann . sannoSnd) xs
   in [r | r@(Arg i _) <- args, i `elem` usedArgs]
 
-mkIdx :: SAnno g One (Indexed c, d) -> Type -> Indexed Type
-mkIdx (SAnno (One (_, (Idx i _, _))) _) = Idx i
+mkIdx :: AnnoS g One (Indexed c, d) -> Type -> Indexed Type
+mkIdx (AnnoS _ (Idx i _, _) _) = Idx i
 
 -- Conventions:
 --   midx: The general index, used for identifying manifolds since this index is
@@ -688,9 +720,9 @@ mkIdx (SAnno (One (_, (Idx i _, _))) _) = Idx i
 --         types. The language of the type cidx is coupled to in `express` must
 --         be the same as the language cidx is coupled to in the SAnno
 --         expression.
-express :: SAnno (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyHead
+express :: AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyHead
 -- CallS - direct export of a sourced function, e.g.:
-express (SAnno (One (CallS src, (Idx cidx lang, _))) (Idx midx c@(FunT inputs _))) = do
+express (AnnoS (Idx midx c@(FunT inputs _)) (Idx cidx lang, _) (CallS src)) = do
   ids <- MM.takeFromCounter (length inputs)
   let lambdaVals = fromJust $ safeZipWith PolyBndVar (map (C . Idx cidx) inputs) ids
   return
@@ -712,61 +744,58 @@ express (SAnno (One (CallS src, (Idx cidx lang, _))) (Idx midx c@(FunT inputs _)
 -- application.
 -- ----
 -- lambda
-express (SAnno (One (LamS _ (SAnno (One (x, (c, _))) (Idx _ applicationType)), (_, lambdaArgs))) (Idx midx _)) = do
+express (AnnoS (Idx midx _) (_, lambdaArgs) (LamS _ (AnnoS (Idx _ applicationType) (c, _) x))) = do
   MM.sayVVV "express LamS:"
-  express (SAnno (One (x, (c, lambdaArgs))) (Idx midx applicationType))
+  express (AnnoS (Idx midx applicationType) (c, lambdaArgs) x)
 
-express (SAnno (One (LstS xs, (Idx cidx lang, args))) (Idx midx (AppT (VarT v) [t]))) = do
+express (AnnoS (Idx midx (AppT (VarT v) [t])) (Idx cidx lang, args) (LstS xs)) = do
   xs' <- mapM (\x -> expressPolyExpr lang (mkIdx x t) x) xs
   let x = PolyList (Idx cidx v) (Idx cidx t) xs'
   return $ PolyHead lang midx [Arg i None | Arg i _ <- args] (PolyReturn x)
-express (SAnno (One (LstS _, _)) (Idx _ t)) = error $ "Invalid list form: " <> show t
+express (AnnoS (Idx _ t) _ (LstS _)) = error $ "Invalid list form: " <> show t
 
-express (SAnno (One (TupS xs, (Idx cidx lang, args))) t@(Idx midx (AppT (VarT v) ts))) = do
+express (AnnoS t@(Idx midx (AppT (VarT v) ts)) (Idx cidx lang, args) (TupS xs)) = do
   MM.sayVVV $ "express TupS:" <+> pretty t
   let idxTs = zipWith mkIdx xs ts
   xs' <- fromJust <$> safeZipWithM (expressPolyExpr lang) idxTs xs
   let x = PolyTuple (Idx cidx v) (fromJust $ safeZip idxTs xs')
   return $ PolyHead lang midx [Arg i None | Arg i _ <- args] (PolyReturn x)
-express (SAnno (One (TupS _, _)) g) = error $ "Invalid tuple form: " <> show g
+
+express (AnnoS g _ (TupS _)) = error $ "Invalid tuple form: " <> show g
 
 -- records
-express (SAnno (One (NamS entries, (Idx cidx lang, args))) (Idx midx (NamT o v ps rs))) = do
+express (AnnoS (Idx midx (NamT o v ps rs)) (Idx cidx lang, args) (NamS entries)) = do
   let idxTypes = zipWith mkIdx (map snd entries) (map snd rs)
   xs' <- fromJust <$> safeZipWithM (expressPolyExpr lang) idxTypes (map snd entries)
   let x = PolyRecord o (Idx cidx v) (map (Idx cidx) ps) (zip (map fst rs) (zip idxTypes xs'))
   return $ PolyHead lang midx [Arg i None | Arg i _ <- args] (PolyReturn x)
 
 -- expand the record type if possible, otherwise die
-express (SAnno (One (NamS entries, (Idx cidx lang, args))) (Idx midx t)) = do
+express (AnnoS (Idx midx t) (Idx cidx lang, args) (NamS entries)) = do
   mayT <- evalGeneralStep midx (type2typeu t)
   case mayT of
-    (Just t') -> express (SAnno (One (NamS entries, (Idx cidx lang, args))) (Idx midx (typeOf t')))
+    (Just t') -> express (AnnoS (Idx midx (typeOf t')) (Idx cidx lang, args) (NamS entries))
     Nothing -> MM.throwError . OtherError . render $ "Missing concrete:" <+> "t=" <> pretty t
 
 -- In other cases, it doesn't matter whether we are at the top of the call
-express e@(SAnno (One (_, (Idx cidx lang, args))) (Idx midx t))
-  = PolyHead lang midx [Arg i None | Arg i _ <- args] <$> expressPolyExpr lang (Idx cidx t) e
+express e = expressDefault e
 
 
+expressDefault :: AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyHead
+expressDefault e@(AnnoS (Idx midx t) (Idx cidx lang, args) _)
+  = PolyHead lang midx [Arg i None | Arg i _ <- args] <$> expressPolyExpr lang (Idx cidx t) e
 
-expressPolyExpr :: Lang -> Indexed Type -> SAnno (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyExpr
 
+expressPolyExpr :: Lang -> Indexed Type -> AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyExpr
 -- these cases will include partially applied functions and explicit lambdas
 -- the former is transformed into the latter in the frontend typechecker
 expressPolyExpr parentLang pc
-  (SAnno (One (LamS vs
-    (SAnno (One (AppS
-      (SAnno (One (CallS src
-                  , (Idx cidxCall callLang, _)
-                  )
-             ) callTypeI@(Idx _ callType@(FunT callInputTypes _)))
-      xs
-                , (Idx cidxApp appLang, appArgs)
-                )
-           ) (Idx _ appType))
-              , (Idx cidxLam _, lamArgs))
-         ) (Idx midx lamType@(FunT lamInputTypes lamOutType)))
+  (AnnoS (Idx midx lamType@(FunT lamInputTypes lamOutType)) (Idx cidxLam _, lamArgs)
+    (LamS vs
+      (AnnoS (Idx _ appType) (Idx cidxApp appLang, appArgs)
+        (AppS
+          (AnnoS callTypeI@(Idx _ callType@(FunT callInputTypes _)) (Idx cidxCall callLang, _)
+            (CallS src)) xs))))
 
   ----------------------------------------------------------------------------------------
   -- #3 cis full lambda                                        | contextArgs | boundArgs |
@@ -786,7 +815,7 @@ expressPolyExpr parentLang pc
 
       let lamIdxTypes = zipWith mkIdx xs lamInputTypes
       let args = fromJust $ safeZipWith (\(Arg i _) t -> Arg i (Just (val t))) lamArgs lamIdxTypes
-      xs' <- fromJust <$> safeZipWithM (expressPolyExpr appLang) (zipWith mkIdx xs callInputTypes) xs 
+      xs' <- fromJust <$> safeZipWithM (expressPolyExpr appLang) (zipWith mkIdx xs callInputTypes) xs
       return
           . PolyManifold parentLang midx (ManifoldPass args)
           . PolyReturn
@@ -979,7 +1008,7 @@ expressPolyExpr parentLang pc
     -- Partitions evaluation of expressions applied to a foreign pool between the
     -- local and foreign contexts
     partialExpress
-        :: SAnno (Indexed Type) One (Indexed Lang, [Arg EVar]) -- expression
+        :: AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]) -- expression
         -> MorlocMonad
             ( [Int] -- ordered foreign arguments, should include ids bound by let (next arg)
             , Maybe (Int, PolyExpr) -- parent let statement if not in child language and eval is needed
@@ -987,7 +1016,7 @@ expressPolyExpr parentLang pc
             )
     -- If the argument is a variable, link the argument id to the variable id and
     -- assign it the foreign call type
-    partialExpress (SAnno (One (VarS v, (Idx cidx argLang, args@[Arg idx _]))) (Idx _ t)) = do
+    partialExpress (AnnoS (Idx _ t) (Idx cidx argLang, args@[Arg idx _]) (BndS v)) = do
       MM.sayVVV $ "partialExpress case #0:" <+> "x=" <> pretty v <+> "cidx=" <> pretty cidx <+> "t =" <+> pretty t
                 <> "\n  parentLang:" <> pretty parentLang
                 <> "\n  callLang:" <> pretty callLang
@@ -996,7 +1025,7 @@ expressPolyExpr parentLang pc
       let x' = PolyBndVar (C (Idx cidx t)) idx
       return ([idx], Nothing, x')
     -- Otherwise
-    partialExpress x@(SAnno (One (_, (Idx cidx argLang, args))) (Idx _ t))
+    partialExpress x@(AnnoS (Idx _ t) (Idx cidx argLang, args) _)
       -- if this expression is implemented on the foreign side,
       --   translate to ExprM and record
       | argLang == callLang = do
@@ -1028,7 +1057,7 @@ expressPolyExpr parentLang pc
           -- Only the let-bound argument is used on the foreign side
           return ([idx], Just (idx, letVal), x')
 
-expressPolyExpr _ _ (SAnno (One (LamS vs body, (Idx _ lang, manifoldArguments))) lambdaType@(Idx midx _)) = do
+expressPolyExpr _ _ (AnnoS lambdaType@(Idx midx _) (Idx _ lang, manifoldArguments) (LamS vs body)) = do
     MM.sayVVV $ "expressPolyExpr LamS:" <+> pretty lambdaType
 
     body' <- expressPolyExpr lang lambdaType body
@@ -1058,7 +1087,8 @@ expressPolyExpr _ _ (SAnno (One (LamS vs body, (Idx _ lang, manifoldArguments)))
 --   connections will be snapped apart in the segment step.
 -- * These applications will be fully applied, the case of partially applied
 --   functions will have been handled previously by LamM
-expressPolyExpr parentLang pc (SAnno (One (AppS (SAnno (One (CallS src, (Idx cidxCall callLang, _))) (Idx _ fc@(FunT inputs _))) xs, (_, args))) (Idx midx _))
+expressPolyExpr parentLang pc (AnnoS (Idx midx _) (_, args) (AppS (AnnoS (Idx _ fc@(FunT inputs _)) (Idx cidxCall callLang, _) (CallS src)) xs))
+
   ----------------------------------------------------------------------------------------
   -- #1 cis applied                                            | contextArgs | boundArgs |
   ----------------------------------------------------------------------------------------
@@ -1128,7 +1158,8 @@ expressPolyExpr parentLang pc (SAnno (One (AppS (SAnno (One (CallS src, (Idx cid
     f = PolySrc (Idx cidxCall fc) src
 
 -- An un-applied source call
-expressPolyExpr parentLang (val -> FunT pinputs poutput) (SAnno (One (CallS src, (Idx cidx callLang, _))) (Idx midx c@(FunT callInputs _)))
+expressPolyExpr parentLang (val -> FunT pinputs poutput) (AnnoS (Idx midx c@(FunT callInputs _)) (Idx cidx callLang, _) (CallS src))
+
   ----------------------------------------------------------------------------------------
   -- #2 cis passed                                             | contextArgs | boundArgs |
   ----------------------------------------------------------------------------------------
@@ -1187,65 +1218,68 @@ expressPolyExpr parentLang (val -> FunT pinputs poutput) (SAnno (One (CallS src,
        $ fromJust $ safeZipWith (PolyBndVar . C) (map (Idx cidx) pinputs) (map ann lambdaArgs)
 
 -- bound variables
-expressPolyExpr _ _ (SAnno (One (VarS v, (Idx cidx _, rs))) (Idx _ c)) = do
+expressPolyExpr _ _ (AnnoS (Idx _ c) (Idx cidx _, rs) (BndS v)) = do
   MM.sayVVV $ "express' VarS" <+> parens (pretty v) <+> "::" <+> pretty c
   case [i | (Arg i v') <- rs, v == v'] of
     [r] -> return $ PolyBndVar (C (Idx cidx c)) r
     rs' -> MM.throwError . OtherError . render
         $ "Expected VarS" <+> dquotes (pretty v) <+>
           "of type" <+> parens (pretty c) <+> "to match exactly one argument, found:" <+> list (map pretty rs')
+        <> "\n  v:" <+> pretty v
+        <> "\n  cidx:" <+> pretty cidx
+        <> "\n  gidx:" <+> pretty cidx
+        <> "\n  rs:" <+> list (map pretty rs)
 
 -- primitives
-expressPolyExpr _ _ (SAnno (One (RealS x, (Idx cidx _, _))) (Idx _ (VarT v))) = return $ PolyReal (Idx cidx v) x
-expressPolyExpr _ _ (SAnno (One (IntS x,  (Idx cidx _, _))) (Idx _ (VarT v))) = return $ PolyInt  (Idx cidx v) x
-expressPolyExpr _ _ (SAnno (One (LogS x,  (Idx cidx _, _))) (Idx _ (VarT v))) = return $ PolyLog  (Idx cidx v) x
-expressPolyExpr _ _ (SAnno (One (StrS x,  (Idx cidx _, _))) (Idx _ (VarT v))) = return $ PolyStr  (Idx cidx v) x
-expressPolyExpr _ _ (SAnno (One (UniS,    (Idx cidx _, _))) (Idx _ (VarT v))) = return $ PolyNull (Idx cidx v) 
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (RealS x )) = return $ PolyReal (Idx cidx v) x
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (IntS x  )) = return $ PolyInt  (Idx cidx v) x
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (LogS x  )) = return $ PolyLog  (Idx cidx v) x
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (StrS x  )) = return $ PolyStr  (Idx cidx v) x
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (UniS    )) = return $ PolyNull (Idx cidx v)
 
 -- record access
-expressPolyExpr _ pc (SAnno (One (AccS record@(SAnno (One (_, (Idx cidx lang, _))) (Idx _ (NamT o v _ rs))) key, _)) _) = do
+expressPolyExpr _ pc (AnnoS _ _ (AccS key record@(AnnoS (Idx _ (NamT o v _ rs)) (Idx cidx lang, _) _))) = do
   record' <- expressPolyExpr lang pc record
   case lookup key rs of
     (Just valType) -> return $ PolyAcc (Idx cidx valType) o (Idx cidx v) record' key
     Nothing -> error "invalid key access"
 
 -- lists
-expressPolyExpr _ _ (SAnno (One (LstS xs, (Idx cidx lang, _))) (Idx _ (AppT (VarT v) [t])))
+expressPolyExpr _ _ (AnnoS (Idx _ (AppT (VarT v) [t])) (Idx cidx lang, _) (LstS xs))
   = PolyList (Idx cidx v) (Idx cidx t) <$> mapM (\x -> expressPolyExpr lang (mkIdx x t) x) xs
-expressPolyExpr _ _ (SAnno (One (LstS _, _)) _) = error "LstS can only be (AppP (VarP _) [_]) type"
+expressPolyExpr _ _ (AnnoS _ _ (LstS _)) = error "LstS can only be (AppP (VarP _) [_]) type"
 
 -- tuples
-expressPolyExpr _ _ (SAnno (One (TupS xs, (Idx cidx lang, _))) (Idx _ (AppT (VarT v) ts))) = do
+expressPolyExpr _ _ (AnnoS (Idx _ (AppT (VarT v) ts)) (Idx cidx lang, _) (TupS xs)) = do
   let idxTs = zipWith mkIdx xs ts
   xs' <- fromJust <$> safeZipWithM (expressPolyExpr lang) idxTs xs
   return $ PolyTuple (Idx cidx v) (fromJust $ safeZip idxTs xs')
-expressPolyExpr _ _ (SAnno (One (TupS _, _)) _) = error "TupS can only be (TupP (TupP _) ts) type"
+expressPolyExpr _ _ (AnnoS _ _ (TupS _)) = error "TupS can only be (TupP (TupP _) ts) type"
 
 -- records
-expressPolyExpr _ _ (SAnno (One (NamS entries, (Idx cidx lang, _))) (Idx _ (NamT o v ps rs))) = do
-  let tsIdx = zipWith mkIdx (map snd entries) (map snd rs) 
+expressPolyExpr _ _ (AnnoS (Idx _ (NamT o v ps rs)) (Idx cidx lang, _) (NamS entries)) = do
+  let tsIdx = zipWith mkIdx (map snd entries) (map snd rs)
   xs' <- fromJust <$> safeZipWithM (expressPolyExpr lang) tsIdx (map snd entries)
   return $ PolyRecord o (Idx cidx v) (map (Idx cidx) ps) (zip (map fst rs) (zip tsIdx xs'))
 
--- Unapplied and unexported source
-expressPolyExpr _ _ (SAnno (One (CallS src, _)) _)
-  = MM.throwError . OtherError . render
-  $ "Cannot export the value" <+> squotes (pretty (srcName src)) <+> "from a pool, you should define this in morloc code instead"
-
-expressPolyExpr _ _ (SAnno (One (AppS (SAnno (One (VarS f, _)) _) _, _)) _)
-  = MM.throwError . ConcreteTypeError $ FunctionSerialization f
+expressPolyExpr _ _ (AnnoS _ _ (AppS (AnnoS _ _ (BndS v)) _))
+  = MM.throwError . ConcreteTypeError $ FunctionSerialization v
 
 -- catch all exception case - not very classy
-expressPolyExpr _ _ (SAnno (One (AppS (SAnno (One (LamS vs _, _)) _) _, _)) _) = error $ "All applications of lambdas should have been eliminated of length " <> show (length vs)
-expressPolyExpr _ parentType (SAnno _ (Idx m t)) = do
+expressPolyExpr _ _ (AnnoS _ _ (AppS (AnnoS _ _ (LamS vs _)) _))
+  = error $ "All applications of lambdas should have been eliminated of length " <> show (length vs)
+expressPolyExpr _ parentType (AnnoS (Idx m t) _ _) = do
   MM.sayVVV "Bad case"
   MM.sayVVV $ "  t :: " <> pretty t
   name' <- MM.metaName m
   case name' of
-      (Just v) -> MM.throwError . OtherError . render $ "Missing concrete:" <+> "t=" <> pretty t <+> "v=" <> pretty v <+> "parentType=" <> pretty parentType
+      (Just v) -> MM.throwError . OtherError . render
+               $ "Missing concrete:"
+               <> "\n  t:" <+> pretty t
+               <> "\n  v:" <+> pretty v
+               <> "\n parentType:" <+> pretty parentType
       Nothing ->  error "Bug in expressPolyExpr - this should be unreachable"
 
-
 unvalue :: Arg a -> Arg None
 unvalue (Arg i _) = Arg i None
 
@@ -1894,56 +1928,9 @@ preprocess Python3Lang es = Python3.preprocess es
 preprocess l _ = MM.throwError . PoolBuildError . render
                $ "Language '" <> viaShow l <> "' has no translator"
 
-mapCM :: (c -> MorlocMonad c') -> SAnno g One c -> MorlocMonad (SAnno g One c')
-mapCM f (SAnno (One (AccS x k, c)) g) = do
-  x' <- mapCM f x
-  c' <- f c
-  return $ SAnno (One (AccS x' k, c')) g
-mapCM f (SAnno (One (LstS xs, c)) g) = do
-  xs' <- mapM (mapCM f) xs
-  c' <- f c
-  return $ SAnno (One (LstS xs', c')) g
-mapCM f (SAnno (One (TupS xs, c)) g) = do
-  xs' <- mapM (mapCM f) xs
-  c' <- f c
-  return $ SAnno (One (TupS xs', c')) g
-mapCM f (SAnno (One (NamS entries, c)) g) = do
-  xs' <- mapM (mapCM f . snd) entries
-  c' <- f c
-  return $ SAnno (One (NamS (zip (map fst entries) xs'), c')) g
-mapCM f (SAnno (One (LamS vs x, c)) g) = do
-  x' <- mapCM f x
-  c' <- f c
-  return $ SAnno (One (LamS vs x', c')) g
-mapCM f (SAnno (One (AppS x xs, c)) g) = do
-  x' <- mapCM f x
-  xs' <- mapM (mapCM f) xs
-  c' <- f c
-  return $ SAnno (One (AppS x' xs', c')) g
-mapCM f (SAnno (One (VarS x, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (VarS x, c')) g
-mapCM f (SAnno (One (CallS src, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (CallS src, c')) g
-mapCM f (SAnno (One (UniS, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (UniS, c')) g
-mapCM f (SAnno (One (RealS x, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (RealS x, c')) g
-mapCM f (SAnno (One (IntS x, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (IntS x, c')) g
-mapCM f (SAnno (One (LogS x, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (LogS x, c')) g
-mapCM f (SAnno (One (StrS x, c)) g) = do
-  c' <- f c
-  return $ SAnno (One (StrS x, c')) g
-
-sannoSnd :: SAnno g One (a, b) -> b
-sannoSnd (SAnno (One (_, (_, x))) _) = x
+
+sannoSnd :: AnnoS g One (a, b) -> b
+sannoSnd (AnnoS _ (_, x) _) = x
 
 -- generate infinite list of fresh variables of form
 -- ['a','b',...,'z','aa','ab',...,'zz',...]
diff --git a/library/Morloc/Frontend/AST.hs b/library/Morloc/Frontend/AST.hs
index f4bfd98e..21eb28bb 100644
--- a/library/Morloc/Frontend/AST.hs
+++ b/library/Morloc/Frontend/AST.hs
@@ -92,7 +92,7 @@ findSignatures _ = []
 
 checkExprI :: Monad m => (ExprI -> m ()) -> ExprI -> m ()
 checkExprI f e@(ExprI _ (ModE _ es)) = f e >> mapM_ (checkExprI f) es
-checkExprI f e@(ExprI _ (AccE e' _)) = f e >> checkExprI f e'
+checkExprI f e@(ExprI _ (AccE _ e')) = f e >> checkExprI f e'
 checkExprI f e@(ExprI _ (AnnE e' _)) = f e >> checkExprI f e'
 checkExprI f e@(ExprI _ (AssE _ e' es')) = f e >> checkExprI f e' >> mapM_ f es'
 checkExprI f e@(ExprI _ (LamE _ e')) = f e >> checkExprI f e'
@@ -104,7 +104,7 @@ checkExprI f e = f e
 
 maxIndex :: ExprI -> Int
 maxIndex (ExprI i (ModE _ es)) = maximum (i : map maxIndex es)
-maxIndex (ExprI i (AccE e _)) = max i (maxIndex e)
+maxIndex (ExprI i (AccE _ e)) = max i (maxIndex e)
 maxIndex (ExprI i (AnnE e _)) = max i (maxIndex e)
 maxIndex (ExprI i (AssE _ e es)) = maximum (i : map maxIndex (e:es))
 maxIndex (ExprI i (LamE _ e)) = max i (maxIndex e)
@@ -116,7 +116,7 @@ maxIndex (ExprI i _) = i
 
 getIndices :: ExprI -> [Int]
 getIndices (ExprI i (ModE _ es)) = i : concatMap getIndices es
-getIndices (ExprI i (AccE e _)) = i : getIndices e
+getIndices (ExprI i (AccE _ e)) = i : getIndices e
 getIndices (ExprI i (AnnE e _)) = i : getIndices e
 getIndices (ExprI i (AssE _ e es)) = i : concatMap getIndices (e:es)
 getIndices (ExprI i (LamE _ e)) = i : getIndices e
diff --git a/library/Morloc/Frontend/Namespace.hs b/library/Morloc/Frontend/Namespace.hs
index 090675ba..d80c2083 100644
--- a/library/Morloc/Frontend/Namespace.hs
+++ b/library/Morloc/Frontend/Namespace.hs
@@ -33,7 +33,7 @@ mapExpr :: (Expr -> Expr) -> ExprI -> ExprI
 mapExpr f = g where
   g (ExprI i (ModE v xs)) = ExprI i . f $ ModE v (map g xs)
   g (ExprI i (AssE v e es)) = ExprI i . f $ AssE v (g e) (map g es)
-  g (ExprI i (AccE e k)) = ExprI i . f $ AccE (g e) k
+  g (ExprI i (AccE k e)) = ExprI i . f $ AccE k (g e)
   g (ExprI i (LstE es)) = ExprI i . f $ LstE (map g es)
   g (ExprI i (TupE es)) = ExprI i . f $ TupE (map g es)
   g (ExprI i (AppE e es)) = ExprI i . f $ AppE (g e) (map g es)
@@ -46,7 +46,7 @@ mapExprM :: Monad m => (Expr -> m Expr) -> ExprI -> m ExprI
 mapExprM f = g where
   g (ExprI i (ModE v xs)) = ExprI i <$> (mapM g xs >>= f . ModE v)
   g (ExprI i (AssE v e es)) = ExprI i <$> ((AssE v <$> g e <*> mapM g es) >>= f)
-  g (ExprI i (AccE e k)) = ExprI i <$> ((AccE <$> g e <*> pure k) >>= f)
+  g (ExprI i (AccE k e)) = ExprI i <$> ((AccE k <$> g e) >>= f)
   g (ExprI i (LstE es)) = ExprI i <$> (mapM g es >>= f . LstE)
   g (ExprI i (TupE es)) = ExprI i <$> (mapM g es >>= f . TupE)
   g (ExprI i (AppE e es)) = ExprI i <$> ((AppE <$> g e <*> mapM g es) >>= f)
diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index 198be440..f7c61680 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -540,7 +540,7 @@ pAcc = do
   e <- parens pExpr <|> pNamE <|> pVar
   _ <- symbol "@"
   f <- freenameL
-  exprI $ AccE e (Key f)
+  exprI $ AccE (Key f) e
 
 
 pAnn :: Parser ExprI
diff --git a/library/Morloc/Frontend/Restructure.hs b/library/Morloc/Frontend/Restructure.hs
index 1b5f3461..0174d4b1 100644
--- a/library/Morloc/Frontend/Restructure.hs
+++ b/library/Morloc/Frontend/Restructure.hs
@@ -253,59 +253,34 @@ filterAndSubstitute links typemap =
 evaluateAllTypes :: DAG MVar [AliasedSymbol] ExprI -> MorlocMonad (DAG MVar [AliasedSymbol] ExprI)
 evaluateAllTypes = MDD.mapNodeM f where
   f :: ExprI -> MorlocMonad ExprI
-  f e0 = do
-    g e0 where
-      g :: ExprI -> MorlocMonad ExprI
-      g (ExprI i (SigE (Signature v l e))) = do
-        gscope <- MM.metaGeneralTypedefs i
-        e' <- evaluateEType gscope e
-        MM.sayVVV $ "evaluateEType"
-          <> "\n  e:" <+> pretty (etype e)
-          <> "\n  e':" <+> pretty (etype e')
-        return $ ExprI i (SigE (Signature v l e'))
-      g (ExprI i (AnnE e ts)) = do
-        gscope <- MM.metaGeneralTypedefs i
-        ts' <- mapM (evaluateTypeU gscope) ts
-        MM.sayVVV $ "evaluateTypeU"
-          <> "\n  ts:" <+> pretty ts
-          <> "\n  ts':" <+> pretty ts'
-        e' <- g e
-        return (ExprI i (AnnE e' ts'))
-      g (ExprI i (ModE m es)) = do
-        es' <- mapM g es
-        return $ ExprI i (ModE m es')
-      g (ExprI i (AssE v e es)) = do
-        e' <- g e
-        es' <- mapM g es
-        return $ ExprI i (AssE v e' es')
-      g (ExprI i (AccE e k)) = do
-        e' <- g e
-        return $ ExprI i (AccE e' k)
-      g (ExprI i (LstE es)) = do
-        es' <- mapM g es
-        return $ ExprI i (LstE es')
-      g (ExprI i (TupE es)) = do
-        es' <- mapM g es
-        return $ ExprI i (TupE es')
-      g (ExprI i (NamE rs)) = do
-        rs' <- mapM (secondM g) rs
-        return $ ExprI i (NamE rs')
-      g (ExprI i (AppE e es)) = do
-        e' <- g e
-        es' <- mapM g es
-        return $ ExprI i (AppE e' es')
-      g (ExprI i (LamE vs e)) = do
-        e' <- g e
-        return $ ExprI i (LamE vs e')
-      g e = return e
-
-      evaluateEType :: Scope -> EType -> MorlocMonad EType
-      evaluateEType gscope et =
-        either MM.throwError (\t' -> return $ et {etype = t'}) $ TE.evaluateType gscope (etype et)
-
-      evaluateTypeU :: Scope -> TypeU -> MorlocMonad TypeU
-      evaluateTypeU gscope t =
-        either MM.throwError return $ TE.evaluateType gscope t
+  f (ExprI i e0) = ExprI i <$> g e0 where
+    g :: Expr -> MorlocMonad Expr
+    g (SigE (Signature v l e)) = do
+      gscope <- MM.metaGeneralTypedefs i
+      e' <- evaluateEType gscope e
+      return $ SigE (Signature v l e')
+    g (AnnE e ts) = do
+      gscope <- MM.metaGeneralTypedefs i
+      ts' <- mapM (evaluateTypeU gscope) ts
+      e' <- f e
+      return (AnnE e' ts')
+    g (ModE m es) = ModE m <$> mapM f es
+    g (AssE v e es) = AssE v <$> f e <*> mapM f es
+    g (AccE k e) = AccE k <$> f e
+    g (LstE es) = LstE <$> mapM f es
+    g (TupE es) = TupE <$> mapM f es
+    g (NamE rs) = NamE <$> mapM (secondM f) rs
+    g (AppE e es) = AppE <$> f e <*> mapM f es
+    g (LamE vs e) = LamE vs <$> f e
+    g e = return e
+
+    evaluateEType :: Scope -> EType -> MorlocMonad EType
+    evaluateEType gscope et =
+      either MM.throwError (\t' -> return $ et {etype = t'}) $ TE.evaluateType gscope (etype et)
+
+    evaluateTypeU :: Scope -> TypeU -> MorlocMonad TypeU
+    evaluateTypeU gscope t =
+      either MM.throwError return $ TE.evaluateType gscope t
 
 
 collectMogrifiers :: DAG MVar [AliasedSymbol] ExprI -> MorlocMonad ()
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index db24e369..bd80f178 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -2,7 +2,7 @@
 
 {-|
 Module      : Morloc.Frontend.Treeify
-Description : Translate from the frontend DAG to the backend SAnno AST forest
+Description : Translate from the frontend DAG to the backend AnnoS AST forest
 Copyright   : (c) Zebulun Arendsee, 2021
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
@@ -14,7 +14,6 @@ module Morloc.Frontend.Treeify (treeify) where
 import Morloc.Frontend.Namespace
 import Morloc.Data.Doc
 import Morloc.Pretty ()
-import qualified Control.Monad as CM
 import qualified Control.Monad.State as CMS
 import qualified Morloc.Frontend.AST as AST
 import qualified Morloc.Monad as MM
@@ -42,7 +41,7 @@ data TermOrigin = Declared ExprI | Sourced Source
 -- and locations in source code.
 treeify
   :: DAG MVar [(EVar, EVar)] ExprI
-  -> MorlocMonad [SAnno Int Many Int]
+  -> MorlocMonad [AnnoS Int ManyPoly Int]
 treeify d
  | Map.size d == 0 = return []
  | otherwise = case DAG.roots d of
@@ -109,7 +108,7 @@ treeify d
                             , stateName = Map.union (stateName s) (Map.fromList exports)})
 
          -- dissolve modules, imports, and sources, leaving behind only a tree for each term exported from main
-         mapM (collect . fst) exports
+         mapM (uncurry collect) exports
 
    -- There is no currently supported use case that exposes multiple roots in
    -- one compilation process. The compiler executable takes a single morloc
@@ -210,7 +209,7 @@ linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
   -- modules currently cannot be nested (should this be allowed?)
   link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
   -- everything below boilerplate
-  link m (ExprI _ (AccE e _)) = link m e
+  link m (ExprI _ (AccE _ e)) = link m e
   link m (ExprI _ (LstE xs)) = mapM_ (link m) xs
   link m (ExprI _ (TupE xs)) = mapM_ (link m) xs
   link m (ExprI _ (LamE vs e)) = link (foldr Map.delete m vs) e
@@ -303,7 +302,7 @@ linkAndRemoveAnnotations = f where
   -- everything below is boilerplate (this is why I need recursion schemes)
   f (ExprI i (ModE v es)) = ExprI i <$> (ModE v <$> mapM f es)
   f (ExprI i (AssE v e es)) = ExprI i <$> (AssE v <$> f e <*> mapM f es)
-  f (ExprI i (AccE e k)) = ExprI i <$> (AccE <$> f e <*> pure k)
+  f (ExprI i (AccE k e)) = ExprI i <$> (AccE k <$> f e)
   f (ExprI i (LstE es)) = ExprI i <$> (LstE <$> mapM f es)
   f (ExprI i (TupE es)) = ExprI i <$> (TupE <$> mapM f es)
   f (ExprI i (NamE rs)) = do
@@ -322,115 +321,109 @@ linkAndRemoveAnnotations = f where
 --       - to detect recursion, I need to remember every term that has been expanded,
 -- collect v declarations or sources
 collect
-  :: Int -- ^ the index for the export term
-  -> MorlocMonad (SAnno Int Many Int)
-collect i = do
-  t0 <- MM.metaMonomorphicTermTypes i
-  case t0 of
-    -- if Nothing, then the term is a bound variable
-    Nothing -> return (SAnno (Many []) i)
-    -- otherwise is an alias that should be replaced with its value(s)
-    (Just t1) -> do
-      let calls = [(CallS src, i') | (_, Idx i' src) <- termConcrete t1]
-      declarations <- mapM (replaceExpr i) (termDecl t1) |>> concat
-      return $ SAnno (Many (calls <> declarations)) i
-
-collectSAnno :: ExprI -> MorlocMonad (SAnno Int Many Int)
-collectSAnno e@(ExprI i (VarE v)) = do
-  MM.sayVVV $ "collectSAnno VarE:" <+> pretty v
-  maybeTermTypes <- MM.metaTermTypes i
-  MM.sayVVV $ "maybeTermTypes:" <+> pretty maybeTermTypes
-
-  es <- case maybeTermTypes of
-    -- if Nothing, then the term is a bound variable
-    Nothing -> return <$> collectSExpr e
-    (Just []) -> error "No instances"
-    -- otherwise is an alias that should be replaced with its value(s)
-    (Just ts) -> do
-      -- collect all the concrete calls across all instances
-      let calls = [(CallS src, i') | (_, Idx i' src) <- concatMap termConcrete ts]
-      -- collect all the morloc compositions with this name across all instances
-      declarations <- mapM reindexExprI (concatMap termDecl ts) >>= mapM (replaceExpr i) |>> concat
-      -- link this index to the name that is removed
-      s <- CMS.get
-      CMS.put (s { stateName = Map.insert i v (stateName s) })
-      -- pool all the calls and compositions with this name
-      return (calls <> declarations)
-  case es of
-    -- TODO: will this case every actually be reached?
-    -- Should all attributes of i be mapped to j, as done with newIndex?
-    -- Should the general type be the j instead?
-    -- Need to dig into this.
-    [] -> do
-      j <- MM.getCounter
-      return $ SAnno (Many [(VarS v, j)]) i
-    es' -> return $ SAnno (Many es') i
-
--- expression type annotations should have already been accounted for, so ignore
-collectSAnno (ExprI _ (AnnE e _)) = collectSAnno e
-collectSAnno e@(ExprI i _) = do
-  e' <- collectSExpr e
-  return $ SAnno (Many [e']) i
-
--- | This function will handle terms that have been set to be equal
-replaceExpr :: Int -> ExprI -> MorlocMonad [(SExpr Int Many Int, Int)]
--- this will be a nested variable
--- e.g.:
---   foo = bar
-replaceExpr i e@(ExprI j (VarE _)) = do
-  x <- collectSAnno e
-  -- unify the data between the equated terms
-  tiMay <- MM.metaMonomorphicTermTypes i
-  tjMay <- MM.metaMonomorphicTermTypes j
-  t <- case (tiMay, tjMay) of
-    (Just ti, Just tj) -> combineTermTypes ti tj
-    (Just ti, _) -> return ti
-    (_, Just tj) -> return tj
-    _ -> error "You shouldn't have done that"
-
-  st <- MM.get
-
-  case GMap.change i (Monomorphic t) (stateSignatures st) of
-    (Just m) -> MM.modify (\s -> s {stateSignatures = m})
-    _ -> error "impossible"
-
-  case GMap.yIsX j i (stateSignatures st) of
-    (Just m) -> MM.put (st {stateSignatures = m})
-    Nothing -> return ()
-
-  -- pass on just the children
-  case x of
-    (SAnno (Many es) _) -> return es
-
-
--- -- two terms may also be equivalent when applied, for example:
--- --   foo x = bar x
--- -- this would be rewritten in the parse as `foo = \x -> bar x`
--- -- meaning foo and bar are equivalent after eta-reduction
--- replaceExpr i e@(ExprI _ (LamE vs (ExprI _ (AppE e2@(ExprI _ (VarE _)) xs))))
---     | map VarE vs == [v | (ExprI _ v) <- xs] = replaceExpr i e2
---     | otherwise = return <$> collectSExpr e
-replaceExpr _ e = return <$> collectSExpr e
-
--- | Translate ExprI to SExpr tree
-collectSExpr :: ExprI -> MorlocMonad (SExpr Int Many Int, Int)
-collectSExpr (ExprI i e0) = (,) <$> f e0 <*> pure i
-  where
-  f (VarE v) = return (VarS v) -- this must be a bound variable
-  f (AccE e x) = AccS <$> collectSAnno e <*> pure x
-  f (LstE es) = LstS <$> mapM collectSAnno es
-  f (TupE es) = TupS <$> mapM collectSAnno es
+  :: Int -- ^ the general index for the term
+  -> EVar
+  -> MorlocMonad (AnnoS Int ManyPoly Int)
+collect gi v = do
+  MM.sayVVV $ "collect"
+            <> "\n  gi:" <+> pretty gi
+            <> "\n  v:" <+> pretty v
+  AnnoS gi gi <$> collectExprS (ExprI gi (VarE v))
+
+
+collectAnnoS :: ExprI -> MorlocMonad (AnnoS Int ManyPoly Int)
+collectAnnoS e@(ExprI gi _) = AnnoS gi gi <$> collectExprS e
+
+-- -- | This function will handle terms that have been set to be equal
+-- replaceExpr :: Int -> ExprI -> MorlocMonad [(ExprS Int ManyPoly Int, Int)]
+-- -- this will be a nested variable
+-- -- e.g.:
+-- --   foo = bar
+-- replaceExpr i e@(ExprI j (VarE _)) = do
+--   x <- collectAnnoS e
+--   -- unify the data between the equated terms
+--   tiMay <- MM.metaMonomorphicTermTypes i
+--   tjMay <- MM.metaMonomorphicTermTypes j
+--   t <- case (tiMay, tjMay) of
+--     (Just ti, Just tj) -> combineTermTypes ti tj
+--     (Just ti, _) -> return ti
+--     (_, Just tj) -> return tj
+--     _ -> error "You shouldn't have done that"
+--
+--   st <- MM.get
+--
+--   case GMap.change i (Monomorphic t) (stateSignatures st) of
+--     (Just m) -> MM.modify (\s -> s {stateSignatures = m})
+--     _ -> error "impossible"
+--
+--   case GMap.yIsX j i (stateSignatures st) of
+--     (Just m) -> MM.put (st {stateSignatures = m})
+--     Nothing -> return ()
+--
+--   -- pass on just the children
+--   case x of
+--     (AnnoS (Many es) _) -> return es
+--
+--
+-- -- -- two terms may also be equivalent when applied, for example:
+-- -- --   foo x = bar x
+-- -- -- this would be rewritten in the parse as `foo = \x -> bar x`
+-- -- -- meaning foo and bar are equivalent after eta-reduction
+-- -- replaceExpr i e@(ExprI _ (LamE vs (ExprI _ (AppE e2@(ExprI _ (VarE _)) xs))))
+-- --     | map VarE vs == [v | (ExprI _ v) <- xs] = replaceExpr i e2
+-- --     | otherwise = return <$> collectSExpr e
+-- replaceExpr _ e = return <$> collectExprS e
+
+-- | Translate ExprI to ExprS tree
+collectExprS :: ExprI -> MorlocMonad (ExprS Int ManyPoly Int)
+collectExprS (ExprI gi e0) = f e0 where
+  f (VarE v) = do
+    MM.sayVVV $ "collectExprS VarE"
+              <> "\n  gi:" <+> pretty gi
+              <> "\n  v:" <+> pretty v
+    sigs <- MM.gets stateSignatures
+    case GMap.lookup gi sigs of
+
+      -- A monomorphic term will have a type if it is linked to any source
+      -- since sources require signatures. But if it associated only with a
+      -- declaration, then it will have no type.
+      (GMapJust (Monomorphic t)) -> do
+        MM.sayVVV $ "  monomorphic:" <+> maybe "?" pretty (termGeneral t)
+        es <- termtypesToAnnoS t
+        return $ VarS v (MonomorphicExpr (termGeneral t) es)
+
+      -- A polymorphic term should always have a type.
+      (GMapJust (Polymorphic cls clsName t ts)) -> do
+        MM.sayVVV $ "  polymorphic:" <+> list (map (maybe "?" pretty . termGeneral) ts) 
+        ess <- mapM termtypesToAnnoS ts
+        let etypes = map (fromJust . termGeneral) ts
+        return $ VarS v (PolymorphicExpr cls clsName t (zip etypes ess))
+
+      -- Terms not associated with TermTypes objects must be lambda-bound
+      _ -> do
+        MM.sayVVV "bound term"
+        return $ BndS v
+    where
+      termtypesToAnnoS :: TermTypes -> MorlocMonad [AnnoS Int ManyPoly Int]
+      termtypesToAnnoS t = do
+        let calls = [AnnoS gi ci (CallS src) | (_, Idx ci src) <- termConcrete t]
+        declarations <- mapM (\ e@(ExprI ci _) -> reindexExprI e >>= collectExprS |>> AnnoS gi ci) (termDecl t)
+        return (calls <> declarations)
+
+  f (AccE k e) = AccS k <$> collectAnnoS e
+  f (LstE es) = LstS <$> mapM collectAnnoS es
+  f (TupE es) = TupS <$> mapM collectAnnoS es
   f (NamE rs) = do
-    xs <- mapM (collectSAnno . snd) rs
+    xs <- mapM (collectAnnoS . snd) rs
     return $ NamS (zip (map fst rs) xs)
-  f (LamE v e) = LamS v <$> collectSAnno e
-  f (AppE e es) = AppS <$> collectSAnno e <*> mapM collectSAnno es
+  f (LamE v e) = LamS v <$> collectAnnoS e
+  f (AppE e es) = AppS <$> collectAnnoS e <*> mapM collectAnnoS es
   f UniE = return UniS
   f (RealE x) = return (RealS x)
   f (IntE x) = return (IntS x)
   f (LogE x) = return (LogS x)
   f (StrE x) = return (StrS x)
-  -- none of the following cases should ever occur
+-- none of the following cases should ever occur
   f ClsE{} = undefined
   f IstE{} = undefined
   f AnnE{} = undefined
@@ -440,14 +433,14 @@ collectSExpr (ExprI i e0) = (,) <$> f e0 <*> pure i
   f ExpE{} = undefined
   f SrcE{} = undefined
   f SigE{} = undefined
-  f (AssE v _ _) = error $ "Found AssE in collectSExpr: " <> show v 
+  f (AssE v _ _) = error $ "Found an unexpected ass in collectExprS: " <> show v 
 
 reindexExprI :: ExprI -> MorlocMonad ExprI
 reindexExprI (ExprI i e) = ExprI <$> newIndex i <*> reindexExpr e
 
 reindexExpr :: Expr -> MorlocMonad Expr
 reindexExpr (ModE m es) = ModE m <$> mapM reindexExprI es
-reindexExpr (AccE e x) = AccE <$> reindexExprI e <*> pure x
+reindexExpr (AccE k e) = AccE k <$> reindexExprI e
 reindexExpr (AnnE e ts) = AnnE <$> reindexExprI e <*> pure ts
 reindexExpr (AppE e es) = AppE <$> reindexExprI e <*> mapM reindexExprI es
 reindexExpr (AssE v e es) = AssE v <$> reindexExprI e <*> mapM reindexExprI es
@@ -479,6 +472,7 @@ linkTypeclasses _ e es
   -- Augment the inherited map with the typeclasses and instances in this module
   >>= findTypeclasses e
 
+
 findTypeclasses
   :: ExprI
   -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
@@ -593,7 +587,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
       -- modules currently cannot be nested (should this be allowed?)
       link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
       -- everything below boilerplate
-      link m (ExprI _ (AccE e _)) = link m e
+      link m (ExprI _ (AccE _ e)) = link m e
       link m (ExprI _ (LstE xs)) = mapM_ (link m) xs
       link m (ExprI _ (TupE xs)) = mapM_ (link m) xs
       link m (ExprI _ (LamE vs e)) = link (foldr Map.delete m vs) e
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index bfca18e8..d82d9a3d 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -9,7 +9,7 @@ License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
 -}
-module Morloc.Frontend.Typecheck (typecheck, resolveTypes, evaluateSAnnoTypes) where
+module Morloc.Frontend.Typecheck (typecheck, resolveTypes, evaluateAnnoSTypes, peakSExpr) where
 
 import Morloc.Frontend.Namespace
 import Morloc.Typecheck.Internal
@@ -21,7 +21,6 @@ import qualified Morloc.Monad as MM
 import qualified Morloc.TypeEval as TE
 import qualified Morloc.Frontend.PartialOrder as MTP
 
-import qualified Control.Monad.State as CMS
 import qualified Data.Map as Map
 
 -- | Each SAnno object in the input list represents one exported function.
@@ -31,38 +30,41 @@ import qualified Data.Map as Map
 -- solved after segregation. Later the concrete types will need to be checked
 -- for type consistency and correctness of packers.
 typecheck
-  :: [SAnno Int Many Int]
-  -> MorlocMonad [SAnno (Indexed TypeU) Many Int]
--- typecheck = error . MT.unpack . render . vsep . map (prettySAnno (const "") (const ""))
+  :: [AnnoS Int ManyPoly Int]
+  -> MorlocMonad [AnnoS (Indexed TypeU) Many Int]
 typecheck = mapM run where
-    run :: SAnno Int Many Int -> MorlocMonad (SAnno (Indexed TypeU) Many Int)
+    run :: AnnoS Int ManyPoly Int -> MorlocMonad (AnnoS (Indexed TypeU) Many Int)
     run e0 = do
 
-      s <- MM.gets stateSignatures
-      MM.sayVVV $ "stateSignatures:\n  " <> pretty s
+      -- s <- MM.gets stateSignatures
+      -- MM.sayVVV $ "stateSignatures:\n  " <> pretty s
 
       -- standardize names for lambda bound variables (e.g., x0, x1 ...)
       let g0 = Gamma {gammaCounter = 0, gammaContext = []}
-          ((_, g1), e1) = renameSAnno (Map.empty, g0) e0
-      (g2, _, e2) <- synthG' g1 e1
+          ((_, g1), e1) = renameAnnoS (Map.empty, g0) e0
+      (g2, _, e2) <- synthG g1 e1
       insetSay "-------- leaving frontend typechecker ------------------"
       insetSay "g2:"
       seeGamma g2
       insetSay "========================================================"
-      let e3 = mapSAnno (fmap normalizeType) id . applyGen g2 $ e2
-      e4 <- resolveInstances e3
+      let e3 = mapAnnoSG (fmap normalizeType) . applyGen g2 $ e2
 
-      s2 <- MM.gets stateSignatures
-      MM.sayVVV $ "resolved stateSignatures:\n  " <> pretty s2
+      resolveInstances g2 (applyGen g2 e3)
 
-      return e4
+      -- s2 <- MM.gets stateSignatures
+      -- MM.sayVVV $ "resolved stateSignatures:\n  " <> pretty s2
+      --
+      -- return e4
 
 -- TypeU --> Type
-resolveTypes :: SAnno (Indexed TypeU) Many Int -> SAnno (Indexed Type) Many Int
-resolveTypes (SAnno (Many es) (Idx i t))
-  = SAnno (Many (map (first f) es)) (Idx i (typeOf t)) where
-  f :: SExpr (Indexed TypeU) Many Int -> SExpr (Indexed Type) Many Int
-  f (AccS x k) = AccS (resolveTypes x) k
+resolveTypes :: AnnoS (Indexed TypeU) Many Int -> AnnoS (Indexed Type) Many Int
+resolveTypes (AnnoS (Idx i t) ci e)
+  = AnnoS (Idx i (typeOf t)) ci (f e) where
+  f :: ExprS (Indexed TypeU) Many Int -> ExprS (Indexed Type) Many Int
+  f (BndS x) = BndS x
+  f (VarS v xs) = VarS v (fmap resolveTypes xs)
+  f (CallS src) = CallS src
+  f (AccS k x) = AccS k (resolveTypes x)
   f (AppS x xs) = AppS (resolveTypes x) (map resolveTypes xs)
   f (LamS vs x) = LamS vs (resolveTypes x)
   f (LstS xs) = LstS (map resolveTypes xs)
@@ -72,168 +74,80 @@ resolveTypes (SAnno (Many es) (Idx i t))
   f (IntS x) = IntS x
   f (LogS x) = LogS x
   f (StrS x) = StrS x
-  f (CallS x) = CallS x
   f UniS = UniS
-  f (VarS x) = VarS x
-
-resolveInstances :: SAnno (Indexed TypeU) Many Int -> MorlocMonad (SAnno (Indexed TypeU) Many Int)
-resolveInstances (SAnno (Many es0) (Idx gidx gtype)) = do
-  MM.sayVVV $ "resolveInstance:" <+> pretty gidx <+> "length(es0)=" <> pretty (length es0) <+> parens (pretty gtype)
-  es' <- mapM resolveExpr es0 |>> catMaybes
-  MM.sayVVV $ "resolveInstance:" <+> pretty gidx <+> "length(es')=" <> pretty (length es')
-  return $ SAnno (Many es') (Idx gidx gtype)
-  where
-  resolveExpr :: (SExpr (Indexed TypeU) Many Int, Int) -> MorlocMonad (Maybe (SExpr (Indexed TypeU) Many Int, Int))
-  -- resolve instance
-  resolveExpr e@(VarS _, i) = filterTermTypes e i
-  resolveExpr e@(CallS _, i) = filterTermTypes e i
+
+resolveInstances :: Gamma -> AnnoS (Indexed TypeU) ManyPoly Int -> MorlocMonad (AnnoS (Indexed TypeU) Many Int)
+resolveInstances g (AnnoS gi@(Idx _ gt) ci e0) = AnnoS gi ci <$> f e0 where
+  f :: ExprS (Indexed TypeU) ManyPoly Int -> MorlocMonad (ExprS (Indexed TypeU) Many Int) 
+
+  -- resolve instances
+  f (VarS v (PolymorphicExpr _ _ _ rss)) = do
+        -- collect all implementations and apply context
+    let es = [AnnoS (Idx i (apply g t)) c e | (AnnoS (Idx i t) c e) <- concatMap snd rss]
+        -- find the types of the most specific instances that are subtypes of the inferred type
+        mostSpecificTypes = MTP.mostSpecificSubtypes gt [t | (AnnoS (Idx _ t) _ _) <- es]
+        -- filter out the most specific subtype expressions
+        es' = [AnnoS (Idx i t) c e | (AnnoS (Idx i t) c e) <- es, t `elem` mostSpecificTypes]
+    VarS v . Many <$> mapM (resolveInstances g) es' 
+
+  f (VarS v (MonomorphicExpr _ xs)) = VarS v . Many <$> mapM (resolveInstances g) xs
+
   -- propagate
-  resolveExpr (AccS x k, i) = do
-    x' <- resolveInstances x
-    filterTermTypes (AccS x' k, i) i
-  resolveExpr (AppS x xs, i) = do
-    x' <- resolveInstances x
-    xs' <- mapM resolveInstances xs
-    filterTermTypes (AppS x' xs', i) i
-  resolveExpr (LamS vs x, i) = do
-    x' <- resolveInstances x
-    filterTermTypes (LamS vs x', i) i
-  resolveExpr (LstS xs, i) = do
-    xs' <- mapM resolveInstances xs
-    filterTermTypes (LstS xs', i) i
-  resolveExpr (TupS xs, i) = do
-    xs' <- mapM resolveInstances xs
-    filterTermTypes (TupS xs', i) i
-  resolveExpr (NamS rs, i) = do
-    rs' <- mapM (secondM resolveInstances) rs
-    filterTermTypes (NamS rs', i) i
-  resolveExpr e@(RealS _, i) = filterTermTypes e i
-  resolveExpr e@(IntS _,  i) = filterTermTypes e i
-  resolveExpr e@(LogS _,  i) = filterTermTypes e i
-  resolveExpr e@(StrS _,  i) = filterTermTypes e i
-  resolveExpr e@(UniS,    i) = filterTermTypes e i
-
-  filterTermTypes :: e -> Int -> MorlocMonad (Maybe e)
-  filterTermTypes x i = do
-    MM.sayVVV $ "filterTermTypes:" <+> pretty i
-    s <- MM.get
-    case GMap.lookup i (stateSignatures s) of
-      (GMapJust (Polymorphic cls v gt ts)) -> do
-        let xs = [(etype t, map (second val) srcs) | (TermTypes (Just t) srcs _) <- ts]
-        let mostSpecificTypes = MTP.mostSpecificSubtypes gtype (map fst xs)
-        let ts' = [t | t@(TermTypes (Just et) _ _) <- ts, etype et `elem` mostSpecificTypes]
-
-        MM.sayVVV $ "  polymorphic type found:" <+> pretty i <+> pretty cls <+> pretty v <+> parens (pretty gt)
-                  <> "\n  length ts:" <+> pretty (length ts)
-                  <> "\n  gtype:" <+> pretty gtype
-                  <> "\n  (map fst xs):" <+> list (map (pretty . fst) xs)
-                  <> "\n  mostSpecificSubtypes gtype (map fst xs):" <+> list (map pretty (MTP.mostSpecificSubtypes gtype (map fst xs)))
-                  <> "\n  length ts':" <+> pretty (length ts')
-
-        return $ if not (null ts')
-          then Just x
-          else Nothing
-      (GMapJust (Monomorphic (TermTypes (Just et) _ _))) -> do
-        MM.sayVVV $ "  monomorphic type found:" <+> pretty i
-                  <> "\n  gtype:" <+> pretty gtype
-                  <> "\n  etype et:" <+> pretty (etype et)
-                  <> "\n  isSubtypeOf gtype (etype et):" <+> pretty (MTP.isSubtypeOf gtype (etype et))
-        return $ if MTP.isSubtypeOf gtype (etype et)
-          then Just x
-          else Nothing
-      _ -> return (Just x)
-
-
--- lookup a general type associated with an index
--- standardize naming of qualifiers
-lookupType :: Int -> Gamma -> MorlocMonad (Maybe (Gamma, TypeU))
-lookupType i g = do
-  m <- CMS.gets stateSignatures
-  case GMap.lookup i m of
-    GMapJust (Monomorphic (TermTypes (Just (EType t _ _)) _ _)) -> do
-      MM.sayVVV $ "lookupType monomorphic:" <+> pretty i <+> "found" <+> parens (pretty t)
-      return . Just $ rename g t
-    GMapJust (Polymorphic cls v (EType t _ _) _) -> do
-      MM.sayVVV $ "lookupType polymorphic:"  <+> pretty i <+> "found" <+> pretty cls <+> pretty v <+> parens (pretty t)
-      return . Just $ rename g t
-    _ -> do
-      MM.sayVVV $ "lookupType failed to find:"  <+> pretty i
-      return Nothing
+  f (AccS k e) = AccS k <$> resolveInstances g e
+  f (AppS e es) = AppS <$> resolveInstances g e <*> mapM (resolveInstances g) es
+  f (LamS vs e) = LamS vs <$> resolveInstances g e
+  f (LstS es) = LstS <$> mapM (resolveInstances g) es
+  f (TupS es) = TupS <$> mapM (resolveInstances g) es
+  f (NamS rs) = NamS <$> mapM (secondM (resolveInstances g)) rs
+
+  -- primitives
+  f UniS = return UniS
+  f (BndS v) = return $ BndS v
+  f (RealS x) = return $ RealS x
+  f (IntS x) = return $ IntS x
+  f (LogS x) = return $ LogS x
+  f (StrS x) = return $ StrS x
+  f (CallS x) = return $ CallS x
+  
 
 -- prepare a general, indexed typechecking error
 gerr :: Int -> TypeError -> MorlocMonad a
 gerr i e = MM.throwError $ IndexedError i (GeneralTypeError e)
 
-synthG
+
+checkG
   :: Gamma
-  -> SAnno Int Many Int
+  -> AnnoS Int ManyPoly Int
+  -> TypeU
   -> MorlocMonad
        ( Gamma
        , TypeU
-       , SAnno (Indexed TypeU) Many Int
+       , AnnoS (Indexed TypeU) ManyPoly Int
        )
--- it is possible to export just a type signature
-synthG g (SAnno (Many []) i) = do
-  maybeType <- lookupType i g
-  case maybeType of
-    (Just (g', t)) -> return (g', t, SAnno (Many []) (Idx i t))
-    -- if a term is associated with no expression or type
-    Nothing -> do
-        maybeName <- CMS.gets (Map.lookup i . stateName)
-        case maybeName of
-            -- This branch is entered for exported type definitions
-            -- FIXME: return all definitions and their parameters, check parameter count
-            (Just (EV v)) -> return (g, VarU (TV v), SAnno (Many []) (Idx i (VarU (TV v))))
-            Nothing -> error "Indexing error, this should not occur, please message the maintainer"
-
-synthG g0 (SAnno (Many ((e0, j):es)) i) = do
-
-  -- Check for any existing type signature annotations
-  maybeType <- lookupType i g0
-  (g1, t1, e1) <- case maybeType of
-    -- If there are no annotations, synthesize
-    Nothing  -> synthE' i g0 e0
-    -- If there are annotations ...
-    (Just (g', t)) -> case e0 of
-      -- If the annotation is of a variable name, return the annotation. Calling
-      -- check would just re-synthesize the same type and check that it was
-      -- equal to itself.
-      (VarS v) -> return (g', t, VarS v)
-      -- Otherwise check the annotation type
-      _ -> checkE' i g' e0 t
-
-  -- Check all other implementations against the first one
-  (g2, t2, SAnno (Many es') _) <- checkG' g1 (SAnno (Many es) i) t1
-
-  -- finally cons the head element back and apply everything we learned
-  let finalExpr = applyGen g2 $ SAnno (Many ((e1, j):es')) (Idx i t2)
-
-  return (g2, t2, finalExpr)
+checkG g (AnnoS i j e) t = do
+  (g', t', e') <- checkE' i g e t
+  return (g', t', AnnoS (Idx i t') j e')
 
-checkG
+synthG
   :: Gamma
-  -> SAnno Int Many Int
-  -> TypeU
+  -> AnnoS Int ManyPoly Int
   -> MorlocMonad
        ( Gamma
        , TypeU
-       , SAnno (Indexed TypeU) Many Int
+       , AnnoS (Indexed TypeU) ManyPoly Int
        )
-checkG g (SAnno (Many []) i) t = return (g, t, SAnno (Many []) (Idx i t))
-checkG g0 (SAnno (Many ((e, j):es)) i) t0 = do
-  (g1, t1, e') <- checkE' i g0 e t0
-  (g2, t2, SAnno (Many es') idType) <- checkG' g1 (SAnno (Many es) i) t1
-  return (g2, t2, SAnno (Many ((e', j):es')) idType)
-
+synthG g (AnnoS gi ci e) = do
+  (g', t, e') <- synthE' gi g e
+  return (g', t, AnnoS (Idx gi t) ci e')
 
 synthE
   :: Int
   -> Gamma
-  -> SExpr Int Many Int
+  -> ExprS Int ManyPoly Int
   -> MorlocMonad
        ( Gamma
        , TypeU
-       , SExpr (Indexed TypeU) Many Int
+       , ExprS (Indexed TypeU) ManyPoly Int
        )
 
 synthE _ g UniS = return (g, BT.unitU, UniS)
@@ -242,10 +156,10 @@ synthE _ g (IntS x) = return (g, BT.intU, IntS x)
 synthE _ g (LogS x) = return (g, BT.boolU, LogS x)
 synthE _ g (StrS x) = return (g, BT.strU, StrS x)
 
-synthE i g0 (AccS e k) = do
-  (g1, t1, e1) <- synthG' g0 e
+synthE i g0 (AccS k e) = do
+  (g1, t1, e1) <- synthG g0 e
   (g2, valType) <- accessRecord g1 t1
-  return (g2, valType, AccS e1 k)
+  return (g2, valType, AccS k e1)
   where
     accessRecord :: Gamma -> TypeU -> MorlocMonad (Gamma, TypeU)
     accessRecord g t@(NamU _ _ _ rs) = case lookup k rs of
@@ -256,7 +170,11 @@ synthE i g0 (AccS e k) = do
         let (g', val) = newvar (unTVar v <> "_" <> unKey k) g
         case access1 v (gammaContext g') of
           (Just (rhs, _, lhs)) -> return (g' { gammaContext = rhs <> [ExistG v ps ((k, val):rs)] <> lhs }, val)
-          Nothing -> gerr i (KeyError k t)
+          Nothing -> do
+            MM.sayVVV $ "Case b"
+                      <> "\n  rs:" <+> pretty rs
+                      <> "\n  v:" <+> pretty v
+            gerr i (KeyError k t)
       (Just val) -> return (g, val)
     accessRecord g t = do
       globalMap <- MM.gets stateGeneralTypedefs
@@ -269,7 +187,7 @@ synthE i g0 (AccS e k) = do
 
 --   -->E0
 synthE _ g (AppS f []) = do
-  (g1, t1, f1) <- synthG' g f
+  (g1, t1, f1) <- synthG g f
   return (g1, t1, AppS f1 [])
 
 --   -->E
@@ -282,7 +200,7 @@ synthE i g0 (AppS f xs0) = do
 
   case mayExpanded of
     -- If the term was eta-expanded, retypecheck it
-    (Just (g', x')) -> synthE i g' x'
+    (Just (g', x')) -> synthE' i g' x'
     -- Otherwise proceed
     Nothing -> do
 
@@ -299,35 +217,37 @@ synthE i g0 (AppS f xs0) = do
       -- put the AppS back together with the synthesized function and input expressions
       return (g2, apply g2 appliedType, AppS (applyGen g2 funExpr0) inputExprs)
 
---   -->I==>
+-- -->I==>
 synthE i g0 f@(LamS vs x) = do
-  (g1, bodyType, _) <- synthG g0 x
+  (_, bodyType, _) <- synthG g0 x
 
+  -- FIXME: Repeated inference here may lead to exponential runtime
+  -- There must be a better way to handle eta reduction ...
   let n = nfargs bodyType
   if n > 0
     then do
-      (g2, f2) <- expand n g1 f
-      insetSay $ "Expanded in -->I==>:" <+> prettySExpr (const "") (const "") f2
-      synthE i g2 f2
+      (g1, f2) <- expand n g0 f
+      synthE' i g1 f2   -- <----- repeat inference -----------------------------
     else do
       -- create existentials for everything and pass it off to check
-      let (g2, ts) = statefulMap (\g' v -> newvar (unEVar v <> "_x") g') g1 vs
-          (g3, ft) = newvar "o_" g2
+      let (g1, ts) = statefulMap (\g' v -> newvar (unEVar v <> "_x") g') g0 vs
+          (g2, ft) = newvar "o_" g1
           finalType = FunU ts ft
-      checkE' i g3 f finalType
+      checkE' i g2 f finalType   -- <----- repeat inference --------------------
   where
     nfargs :: TypeU -> Int
     nfargs (FunU ts _) = length ts
     nfargs (ForallU _ f') = nfargs f'
     nfargs _ = 0
 
+
 --   List
 synthE _ g (LstS []) =
   let (g1, itemType) = newvar "itemType_" g
       listType = BT.listU itemType
   in return (g1, listType, LstS [])
 synthE i g (LstS (e:es)) = do
-  (g1, itemType, itemExpr) <- synthG' g e
+  (g1, itemType, itemExpr) <- synthG g e
   (g2, listType, listExpr) <- checkE' i g1 (LstS es) (BT.listU itemType)
   case listExpr of
     (LstS es') -> return (g2, listType, LstS (itemExpr:es'))
@@ -339,7 +259,7 @@ synthE _ g (TupS []) =
   in return (g, t, TupS [])
 synthE i g (TupS (e:es)) = do
   -- synthesize head
-  (g1, itemType, itemExpr) <- synthG' g e
+  (g1, itemType, itemExpr) <- synthG g e
 
   -- synthesize tail
   (g2, tupleType, tupleExpr) <- synthE' i g1 (TupS es)
@@ -363,46 +283,81 @@ synthE _ g0 (NamS rs) = do
       e = NamS (zip ks es)
   return (g2, t, e)
 
--- Sources are axiomatic. They are they type they are said to be.
-synthE i g (CallS src) = do
-  maybeType <- lookupType i g
-  (g', t) <- case maybeType of
-    Just x -> return x
-    -- no, then I don't know what it is and will return an existential
-    -- if this existential is never solved, then it will become universal later
-    Nothing -> return $ newvar "src_" g
-  return (g', t, CallS src)
-
 -- Any morloc variables should have been expanded by treeify. Any bound
 -- variables should be checked against. I think (this needs formalization).
-synthE i g (VarS v) = do
-  MM.sayVVV $ "synthE VarS:" <+> tupled [pretty i, pretty v]
+synthE _ g0 (VarS v (MonomorphicExpr (Just t0) xs0)) = do
+  let (g1, t1) = rename g0 (etype t0)
+  (g2, t2, xs1) <- foldCheck g1 xs0 t1 
+  let xs2 = applyCon g2 $ VarS v (MonomorphicExpr (Just t0) xs1)
+  return (g2, t2, xs2)
+
+synthE _ g (VarS v (MonomorphicExpr Nothing (x:xs))) = do
+  (g', t', x') <- synthG g x
+  (g'', t'', xs') <- foldCheck g' xs t'
+  let xs'' = applyCon g'' $ VarS v (MonomorphicExpr Nothing (x':xs'))
+  return (g'', t'', xs'')
+
+synthE _ g (VarS v (MonomorphicExpr Nothing [])) = do
+  let (g', t) = newvar (unEVar v <> "_u") g
+  return (g', t, VarS v (MonomorphicExpr Nothing []))
+  
+synthE i g0 (VarS v (PolymorphicExpr cls clsName t0 rs0)) = do
+  let (g1, t1) = toExistential g0 (etype t0)
+  rs' <- checkInstances g1 t1 rs0
+  return (g1, t1, VarS v (PolymorphicExpr cls clsName t0 rs'))
 
-  -- is this a bound variable that has already been solved
-  (g', t') <- case lookupE v g of
-    -- yes, return the solved type
-    (Just t) -> return (g, t)
-    Nothing -> do
-    -- no, so is it a variable that has a type annotation?
-      maybeType <- lookupType i g
-      case maybeType of
-        Just x -> return x
-        -- no, then I don't know what it is and will return an existential
-        -- if this existential is never solved, then it will become universal later
-        Nothing -> return $ newvar (unEVar v <> "_u") g
+  where
 
-  MM.sayVVV $ "synthE VarS found type:" <+> pretty t'
+    -- check each instance
+    -- do not return modified Gamma state
+    checkInstances
+      :: Gamma
+      -> TypeU
+      -> [(EType, [AnnoS Int ManyPoly Int])]
+      -> MorlocMonad [(EType, [AnnoS (Indexed TypeU) ManyPoly Int])]
+    checkInstances _ _ [] = return []
+    checkInstances g10 genType ((instType, es):rs) = do
+      rs' <- checkInstances g10 genType rs
+      g11 <- subtype' i (etype instType) genType g10
+      es' <- checkImplementations g11 genType es
+      return ((instType, es'):rs')
+
+    -- check each implementation within each instance
+    -- do not return modified Gamma state
+    checkImplementations
+      :: Gamma
+      -> TypeU
+      -> [AnnoS Int ManyPoly Int]
+      -> MorlocMonad [AnnoS (Indexed TypeU) ManyPoly Int]
+    checkImplementations _ _ [] = return []
+    checkImplementations g t (e:es) = do
+      es' <- checkImplementations g t es
+      (_, _, e') <- checkG g e t
+      return (e':es')
+
+-- This case will only be encountered in check, the existential generated here
+-- will be subtyped against the type known from the VarS case.
+synthE _ g (CallS src) = do 
+  let (g', t) = newvar "call_" g
+  return (g', t, CallS src)
 
-  return (g', t', VarS v)
+synthE _ g (BndS v) = do
+  (g', t') <- case lookupE v g of 
+    -- yes, return the solved type
+    (Just t) -> return (g, t)
+    -- no, then I don't know what it is and will return an existential
+    -- if this existential is never solved, then it will become universal later 
+    Nothing -> return $ newvar (unEVar v <> "_u") g
+  return (g', t', BndS v)
 
 
-etaExpand :: Gamma -> SAnno Int Many Int -> [SAnno Int Many Int] -> TypeU -> MorlocMonad (Maybe (Gamma, SExpr Int Many Int))
+etaExpand :: Gamma -> AnnoS Int f Int -> [AnnoS Int f Int] -> TypeU -> MorlocMonad (Maybe (Gamma, ExprS Int f Int))
 etaExpand g0 f0 xs0@(length -> termSize) (normalizeType -> FunU (length -> typeSize) _)
     | termSize == typeSize = return Nothing
     | otherwise = Just <$> etaExpandE g0 (AppS f0 xs0)
     where
 
-    etaExpandE :: Gamma -> SExpr Int Many Int -> MorlocMonad (Gamma, SExpr Int Many Int)
+    etaExpandE :: Gamma -> ExprS Int f Int -> MorlocMonad (Gamma, ExprS Int f Int)
     etaExpandE g e@(AppS _ _) = tryExpand (typeSize - termSize) g e
     etaExpandE g e@(LamS vs _) = tryExpand (typeSize - termSize - length vs) g e
     etaExpandE g e = return (g, e)
@@ -416,42 +371,42 @@ etaExpand g0 f0 xs0@(length -> termSize) (normalizeType -> FunU (length -> typeS
 etaExpand _ _ _ _ = return Nothing
 
 
-expand :: Int -> Gamma -> SExpr Int Many Int -> MorlocMonad (Gamma, SExpr Int Many Int)
+expand :: Int -> Gamma -> ExprS Int f Int -> MorlocMonad (Gamma, ExprS Int f Int)
 expand 0 g x = return (g, x)
 expand n g e@(AppS _ _) = do
     newIndex <- MM.getCounter
     let (g', v') = evarname g "v"
     e' <- applyExistential v' e
-    let x' = LamS [v'] (SAnno (Many [(e', newIndex)]) newIndex)
+    let x' = LamS [v'] (AnnoS newIndex newIndex e')
     expand (n-1) g' x'
-expand n g (LamS vs' (SAnno (Many es0') t)) = do
+expand n g (LamS vs' (AnnoS t ci e)) = do
     let (g', v') = evarname g "v"
-    es1' <- mapM (applyExistential v' . fst) es0'
-    expand (n-1) g' (LamS (vs' <> [v']) (SAnno (Many (zip es1' (map snd es0'))) t))
+    e' <- applyExistential v' e
+    expand (n-1) g' (LamS (vs' <> [v']) (AnnoS t ci e'))
 expand _ g x = return (g, x)
 
 
-applyExistential :: EVar -> SExpr Int Many Int -> MorlocMonad (SExpr Int Many Int)
+applyExistential :: EVar -> ExprS Int f Int -> MorlocMonad (ExprS Int f Int)
 applyExistential v' (AppS f xs') = do
     newIndex <- MM.getCounter
-    return $ AppS f (xs' <> [SAnno (Many [(VarS v', newIndex)]) newIndex])
+    return $ AppS f (xs' <> [AnnoS newIndex newIndex (BndS v')])
 -- possibly illegal application, will type check after expansion
 applyExistential v' e = do
     appIndex <- MM.getCounter
     varIndex <- MM.getCounter
-    return $ AppS (SAnno (Many [(e, appIndex)]) appIndex) [SAnno (Many [(VarS v', varIndex)]) varIndex]
+    return $ AppS (AnnoS appIndex appIndex e) [AnnoS varIndex varIndex (BndS v')]
 
 
 
 application
   :: Int
   -> Gamma
-  -> [SAnno Int Many Int] -- the expressions that are passed to the function
+  -> [AnnoS Int ManyPoly Int] -- the expressions that are passed to the function
   -> TypeU -- the function type
   -> MorlocMonad
       ( Gamma
       , TypeU -- output function type
-      , [SAnno (Indexed TypeU) Many Int] -- @e@, with type annotation
+      , [AnnoS (Indexed TypeU) ManyPoly Int] -- @e@, with type annotation
       )
 
 --  g1 |- e <= A -| g2
@@ -500,17 +455,17 @@ application i _ _ _ = do
 zipCheck
   :: Int
   -> Gamma
-  -> [SAnno Int Many Int]
+  -> [AnnoS Int ManyPoly Int]
   -> [TypeU]
   -> MorlocMonad
     ( Gamma
     , [TypeU]
-    , [SAnno (Indexed TypeU) Many Int]
+    , [AnnoS (Indexed TypeU) ManyPoly Int]
     , [TypeU] -- remainder
     )
 -- check the first elements, cdr down the remaining values
 zipCheck i g0 (x0:xs0) (t0:ts0) = do
-  (g1, t1, x1) <- checkG' g0 x0 t0
+  (g1, t1, x1) <- checkG g0 x0 t0
   (g2, ts1, xs1, remainder) <- zipCheck i g1 xs0 ts0
   return (g2, t1:ts1, x1:xs1, remainder)
 -- If there are fewer arguments than types, this may be OK, just partial application
@@ -519,26 +474,38 @@ zipCheck _ g0 [] ts = return (g0, [], [], ts)
 zipCheck i _ _ [] = gerr i TooManyArguments
 
 
+foldCheck
+  :: Gamma
+  -> [AnnoS Int ManyPoly Int]
+  -> TypeU
+  -> MorlocMonad (Gamma, TypeU, [AnnoS (Indexed TypeU) ManyPoly Int])
+foldCheck g [] t = return (g, t, [])
+foldCheck g (x:xs) t = do
+  (g', t', x') <- checkG g x t  
+  (g'', t'', xs') <- foldCheck g' xs t'
+  return (g'', t'', x':xs')
+
+
 checkE
   :: Int
   -> Gamma
-  -> SExpr Int Many Int
+  -> ExprS Int ManyPoly Int
   -> TypeU
   -> MorlocMonad
        ( Gamma
        , TypeU
-       , SExpr (Indexed TypeU) Many Int
+       , ExprS (Indexed TypeU) ManyPoly Int
        )
 checkE i g1 (LstS (e:es)) (AppU v [t]) = do
-  (g2, t2, e') <- checkG' g1 e t
+  (g2, t2, e') <- checkG g1 e t
   -- LstS [] will go to the normal Sub case
-  (g3, t3, LstS es') <- checkE i g2 (LstS es) (AppU v [t2])
+  (g3, t3, LstS es') <- checkE' i g2 (LstS es) (AppU v [t2])
   return (g3, t3, LstS (map (applyGen g3) (e':es')))
 
 checkE i g0 e0@(LamS vs body) t@(FunU as b)
     | length vs == length as = do
         let g1 = g0 ++> zipWith AnnG vs as
-        (g2, t2, e2) <- checkG' g1 body b
+        (g2, t2, e2) <- checkG g1 body b
 
         let t3 = apply g2 (FunU as t2)
             e3 = applyCon g2 (LamS vs e2)
@@ -547,7 +514,7 @@ checkE i g0 e0@(LamS vs body) t@(FunU as b)
 
     | otherwise = do
         (g', e') <- expand (length as - length vs) g0 e0
-        checkE i g' e' t
+        checkE' i g' e' t
 
 checkE i g1 e1 (ForallU v a) = checkE' i (g1 +> v) e1 (substitute v a)
 
@@ -569,34 +536,38 @@ subtype' i a b g = do
 
 -- helpers
 
--- apply context to a SAnno
+-- apply context to a AnnoS
 applyGen :: (Functor gf, Traversable f, Applicable g)
-         => Gamma -> SAnno (gf g) f c -> SAnno (gf g) f c
-applyGen g = mapSAnno (fmap (apply g)) id
+         => Gamma -> AnnoS (gf g) f c -> AnnoS (gf g) f c
+applyGen g = mapAnnoSG (fmap (apply g))
 
 applyCon :: (Functor gf, Traversable f, Applicable g)
-         => Gamma -> SExpr (gf g) f c -> SExpr (gf g) f c
-applyCon g = mapSExpr (fmap (apply g)) id
+         => Gamma -> ExprS (gf g) f c -> ExprS (gf g) f c
+applyCon g = mapExprSG (fmap (apply g))
 
+evaluateAnnoSTypes :: Traversable f => AnnoS (Indexed TypeU) f Int -> MorlocMonad (AnnoS (Indexed TypeU) f Int)
+evaluateAnnoSTypes = mapAnnoSGM resolve where
+  resolve :: Indexed TypeU -> MorlocMonad (Indexed TypeU)
+  resolve (Idx m t) = do
+    scope <- getScope m
+    case TE.evaluateType scope t of
+      (Left e) -> MM.throwError e
+      (Right tu) -> return (Idx m tu)
 
----- debugging
+  getScope :: Int -> MorlocMonad Scope
+  getScope i= do
+    globalMap <- MM.gets stateGeneralTypedefs
+    case GMap.lookup i globalMap of
+      GMapNoFst -> return Map.empty
+      GMapNoSnd -> return Map.empty
+      GMapJust scope -> return scope
 
-synthG' g x = do
-  enter "synthG"
-  r <- synthG g x
-  leave "synthG"
-  return r
 
-checkG' g x t = do
-  enter "checkG"
-  r <- checkG g x t
-  leave "checkG"
-  return r
+---- debugging
 
 synthE' i g x = do
   enter "synthE"
   insetSay $ "synthesize type for: " <> peakSExpr x
-  seeGamma g
   r@(g', t, _) <- synthE i g x
   leave "synthE"
   seeGamma g'
@@ -607,7 +578,6 @@ checkE' i g x t = do
   enter "checkE"
   insetSay $ "check if expr: " <> peakSExpr x
   insetSay $ "matches type: " <> pretty t
-  seeGamma g
   r@(g', t', _) <- checkE i g x t
   leave "checkE"
   seeGamma g'
@@ -616,19 +586,20 @@ checkE' i g x t = do
 
 application' i g es t = do
   enter "application"
-  seeGamma g
   seeType t
+  insetSay $ "es:" <+> list [peakSExpr e | (AnnoS _ _ e) <- es]
   r@(g',t',_) <- application i g es t
   leave "application"
   seeGamma g'
   seeType t'
-  -- mapM_ peakGen es'
   return r
 
-peakSExpr :: SExpr Int Many Int -> MDoc
+peakSExpr :: ExprS Int ManyPoly Int -> MDoc
 peakSExpr UniS = "UniS"
-peakSExpr (VarS v) = "VarS" <+> pretty v
-peakSExpr (AccS _ k) = "AccS" <> brackets (pretty k)
+peakSExpr (VarS v (MonomorphicExpr mayT _)) = "VarS" <+> pretty v <+> "::" <+> maybe "?" pretty mayT
+peakSExpr (VarS v (PolymorphicExpr cls _ t _)) = "VarS" <+> pretty cls <+> " => " <+> pretty v <+> "::" <+> pretty t
+peakSExpr (BndS v) = "BndS" <+> pretty v
+peakSExpr (AccS k _) = "AccS" <> brackets (pretty k)
 peakSExpr (AppS _ xs) = "AppS" <+> "nargs=" <> pretty (length xs)
 peakSExpr (LamS vs _) = "LamS" <> tupled (map pretty vs)
 peakSExpr (LstS xs) = "LstS" <> "n=" <> pretty (length xs)
@@ -639,21 +610,3 @@ peakSExpr (IntS x) = "IntS" <+> pretty x
 peakSExpr (LogS x) = "LogS" <+> pretty  x
 peakSExpr (StrS x) = "StrS" <+> pretty x
 peakSExpr (CallS src) = "CallS" <+> pretty src
-
-
-evaluateSAnnoTypes :: SAnno (Indexed TypeU) Many Int -> MorlocMonad (SAnno (Indexed TypeU) Many Int)
-evaluateSAnnoTypes = mapSAnnoM resolve return where
-  resolve :: Indexed TypeU -> MorlocMonad (Indexed TypeU)
-  resolve (Idx m t) = do
-    scope <- getScope m
-    case TE.evaluateType scope t of
-      (Left e) -> MM.throwError e
-      (Right tu) -> return (Idx m tu)
-
-  getScope :: Int -> MorlocMonad Scope
-  getScope i= do
-    globalMap <- CMS.gets stateGeneralTypedefs
-    case GMap.lookup i globalMap of
-      GMapNoFst -> return Map.empty
-      GMapNoSnd -> return Map.empty
-      GMapJust scope -> return scope
diff --git a/library/Morloc/Monad.hs b/library/Morloc/Monad.hs
index 89d37233..45778bdd 100644
--- a/library/Morloc/Monad.hs
+++ b/library/Morloc/Monad.hs
@@ -308,6 +308,7 @@ metaProperties i = do
     (GMapJust (Polymorphic _ _ e _)) -> Set.toList (eprop e)
     _ -> []
 
+----- TODO: metaName should no longer be required - remove
 -- | The name of a morloc composition. These names are stored in the monad
 -- after they are resolved away. For example in:
 --   import math
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index 9bbe3dd5..070c7cb5 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -22,6 +22,7 @@ module Morloc.Namespace
   , One(..)
   , Or(..)
   , Many(..)
+  , ManyPoly(..)
   -- ** Other classes
   , Three(..)
   , Defaultable(..)
@@ -86,12 +87,20 @@ module Morloc.Namespace
   , Constraint(..)
   , Property(..)
   -- ** Types used in post-typechecking tree
-  , SAnno(..)
-  , SExpr(..)
-  , mapSAnno
-  , mapSExpr
-  , mapSAnnoM
-  , mapSExprM
+  , AnnoS(..)
+  , ExprS(..)
+  , mapAnnoSM
+  , mapExprSM
+  , mapAnnoS
+  , mapExprS
+  , mapAnnoSC
+  , mapAnnoSCM
+  , mapAnnoSG
+  , mapAnnoSGM
+  , mapExprSC
+  , mapExprSCM
+  , mapExprSG
+  , mapExprSGM
   -- ** Typeclasses
   , HasOneLanguage(..)
   , Typelike(..)
@@ -157,7 +166,7 @@ data MorlocState = MorlocState
   -- ^ Used in Treeify generate new indices (starting from max parser index).
   -- Also used (after resetting to 0) in each of the backend generators.
   , stateDepth :: Int
-  -- ^ store depth in the SAnno tree in the frontend and backend typecheckers
+  -- ^ store depth in the AnnoS tree in the frontend and backend typecheckers
   , stateSignatures :: GMap Int Int SignatureSet
   , stateConcreteTypedefs :: GMap Int MVar (Map Lang Scope)
   -- ^ stores type functions that are in scope for a given module and language
@@ -301,7 +310,7 @@ data Expr
   -- ^ (())
   | VarE EVar
   -- ^ (x)
-  | AccE ExprI Key
+  | AccE Key ExprI
   -- ^ person@age - access a field in a record
   | LstE [ExprI]
   | TupE [ExprI]
@@ -560,11 +569,84 @@ data Source =
     }
   deriving (Ord, Eq, Show)
 
--- g: an annotation for the group of child trees (what they have in common)
--- f: a collection - before realization this will be Many
---                 - after realization it will be One
--- c: an annotation for the specific child tree
-data SAnno g f c = SAnno (f (SExpr g f c, c)) g
+
+data AnnoS g f c = AnnoS g c (ExprS g f c)
+
+data ExprS g f c
+  = UniS
+  | BndS EVar
+  | VarS EVar (f (AnnoS g f c))
+  | AccS Key (AnnoS g f c)
+  | AppS (AnnoS g f c) [AnnoS g f c]
+  | LamS [EVar] (AnnoS g f c)
+  | LstS [AnnoS g f c]
+  | TupS [AnnoS g f c]
+  | NamS [(Key, AnnoS g f c)]
+  | RealS Scientific
+  | IntS Integer
+  | LogS Bool
+  | StrS Text
+  | CallS Source
+
+
+mapExprSM :: (Traversable f, Monad m) => (AnnoS g f c -> m (AnnoS g' f c')) -> ExprS g f c -> m (ExprS g' f c')
+mapExprSM f (VarS v xs) = VarS v <$> traverse f xs
+mapExprSM f (AccS k x) = AccS k <$> f x
+mapExprSM f (AppS x xs) = AppS <$> f x <*> mapM f xs
+mapExprSM f (LamS vs x) = LamS vs <$> f x
+mapExprSM f (LstS xs) = LstS <$> mapM f xs
+mapExprSM f (TupS xs) = TupS <$> mapM f xs
+mapExprSM f (NamS rs) = NamS <$> mapM (secondM f) rs
+mapExprSM _ UniS = return UniS
+mapExprSM _ (BndS v) = return $ BndS v
+mapExprSM _ (RealS x) = return $ RealS x
+mapExprSM _ (IntS x) = return $ IntS x
+mapExprSM _ (LogS x) = return $ LogS x
+mapExprSM _ (StrS x) = return $ StrS x
+mapExprSM _ (CallS x) = return $ CallS x
+
+mapAnnoSM :: (Traversable f, Monad m) => (ExprS g f c -> g -> c -> m (g', c')) -> AnnoS g f c -> m (AnnoS g' f c')
+mapAnnoSM fun (AnnoS g c e) = do
+  e' <- mapExprSM (mapAnnoSM fun) e
+  (g', c') <- fun e g c
+  return (AnnoS g' c' e')
+
+mapAnnoS :: (Traversable f) => (ExprS g f c -> g -> c -> (g', c')) -> AnnoS g f c -> AnnoS g' f c'
+mapAnnoS fun = runIdentity . mapAnnoSM (\x g c -> return (fun x g c))
+
+mapExprS :: (Traversable f) => (AnnoS g f c -> AnnoS g' f c') -> ExprS g f c -> ExprS g' f c'
+mapExprS fun = runIdentity . mapExprSM (return . fun)
+
+mapAnnoSGM :: (Traversable f, Monad m) => (g -> m g') -> AnnoS g f c -> m (AnnoS g' f c)
+mapAnnoSGM f = mapAnnoSM (\_ gi ci -> (,) <$> f gi <*> pure ci)
+
+mapAnnoSCM :: (Traversable f, Monad m) => (c -> m c') -> AnnoS g f c -> m (AnnoS g f c')
+mapAnnoSCM f = mapAnnoSM (\_ gi ci -> (,) gi <$> f ci)
+
+mapAnnoSG :: (Traversable f) => (g -> g') -> AnnoS g f c -> AnnoS g' f c
+mapAnnoSG f = mapAnnoS (\_ gi ci -> (f gi, ci))
+
+mapAnnoSC :: (Traversable f) => (c -> c') -> AnnoS g f c -> AnnoS g f c'
+mapAnnoSC f = mapAnnoS (\_ gi ci -> (gi, f ci))
+
+mapExprSGM :: (Traversable f, Monad m) => (g -> m g') -> ExprS g f c -> m (ExprS g' f c)
+mapExprSGM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS <$> f gi <*> pure ci <*> mapExprSGM f e)
+
+mapExprSCM :: (Traversable f, Monad m) => (c -> m c') -> ExprS g f c -> m (ExprS g f c')
+mapExprSCM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS gi <$> f ci <*> mapExprSCM f e)
+
+mapExprSG :: (Traversable f) => (g -> g') -> ExprS g f c -> ExprS g' f c
+mapExprSG f = mapExprS (\(AnnoS gi ci e) -> AnnoS (f gi) ci (mapExprSG f e))
+
+mapExprSC :: (Traversable f) => (c -> c') -> ExprS g f c -> ExprS g f c'
+mapExprSC f = mapExprS (\(AnnoS gi ci e) -> AnnoS gi (f ci) (mapExprSC f e))
+
+
+-- -- g: an annotation for the group of child trees (what they have in common)
+-- -- f: a collection - before realization this will be Many
+-- --                 - after realization it will be One
+-- -- c: an annotation for the specific child tree
+-- data SAnno g f c = SAnno (f (SExpr g f c, c)) g
 
 data Three a b c = A a | B b | C c
   deriving (Ord, Eq, Show)
@@ -578,6 +660,9 @@ newtype One a = One { unOne :: a }
 newtype Many a = Many { unMany :: [a] }
   deriving (Show)
 
+data ManyPoly a = MonomorphicExpr (Maybe EType) [a] | PolymorphicExpr Typeclass EVar EType [(EType, [a])]
+  deriving(Show, Eq, Ord)
+
 data Or a b = L a | R b | LR a b
   deriving(Ord, Eq, Show)
 
@@ -587,18 +672,31 @@ instance Functor One where
 instance Functor Many where
   fmap f (Many x) = Many (map f x)
 
-instance Traversable Many where
-  traverse f (Many xs) = Many <$> traverse f xs
+instance Functor ManyPoly where
+  fmap f (MonomorphicExpr t xs) = MonomorphicExpr t (map f xs)
+  fmap f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t (map (second (map f)) xs)
 
 instance Traversable One where
   traverse f (One x) = One <$> f x
 
+instance Traversable Many where
+  traverse f (Many xs) = Many <$> traverse f xs
+
+instance Traversable ManyPoly where
+  traverse f (MonomorphicExpr t xs) = MonomorphicExpr t <$> traverse f xs
+  traverse f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t <$> traverse f2 xs where
+    f2 (t', x) = (,) t' <$> traverse f x
+
 instance Foldable One where
   foldr f b (One a) = f a b
 
 instance Foldable Many where
   foldr f b (Many xs) = foldr f b xs
 
+instance Foldable ManyPoly where
+  foldr f b (MonomorphicExpr _ xs) = foldr f b xs
+  foldr f b (PolymorphicExpr _ _ _ (concatMap snd -> xs)) = foldr f b xs
+
 instance Bifunctor Or where
   bimapM f _ (L a) = L <$> f a
   bimapM _ g (R a) = R <$> g a
@@ -613,59 +711,6 @@ instance Bifoldable Or where
     return [c1, c2]
 
 
-data SExpr g f c
-  = UniS
-  | VarS EVar
-  | AccS (SAnno g f c) Key
-  | AppS (SAnno g f c) [SAnno g f c]
-  | LamS [EVar] (SAnno g f c)
-  -- containers
-  | LstS [SAnno g f c]
-  | TupS [SAnno g f c]
-  | NamS [(Key, SAnno g f c)]
-  -- primitives
-  | RealS Scientific
-  | IntS Integer
-  | LogS Bool
-  | StrS Text
-  | CallS Source
-
-mapSAnno :: Traversable f => (g -> g') -> (c -> c') -> SAnno g f c -> SAnno g' f c'
-mapSAnno fg fc = runIdentity . mapSAnnoM (return . fg) (return . fc)
-
-mapSExpr :: Traversable f => (g -> g') -> (c -> c') -> SExpr g f c -> SExpr g' f c'
-mapSExpr fg fc = runIdentity . mapSExprM (return . fg) (return . fc)
-
-mapSAnnoM :: (Traversable f, Monad m) => (g -> m g') -> (c -> m c') -> SAnno g f c -> m (SAnno g' f c')
-mapSAnnoM fg fc (SAnno e g) = do
-  g' <- fg g
-  e' <- traverse mapSExprM' e
-  return $ SAnno e' g'
-  where
-    mapSExprM' (x, c) = do
-      c' <- fc c
-      x' <- mapSExprM fg fc x
-      return (x', c')
-
-mapSExprM :: (Traversable f, Monad m) => (g -> m g') -> (c -> m c') -> SExpr g f c -> m (SExpr g' f c')
-mapSExprM fg fc = fe where 
-  m = mapSAnnoM fg fc
-  fe UniS = return UniS
-  fe (VarS v) = return $ VarS v
-  fe (AccS x k) = AccS <$> m x <*> pure k
-  fe (AppS x xs) = AppS <$> m x <*> mapM m xs
-  fe (LamS vs x) = LamS vs <$> m x
-  fe (LstS xs) = LstS <$> mapM m xs
-  fe (TupS xs) = TupS <$> mapM m xs
-  fe (NamS rs) = do
-    es' <- mapM (m. snd) rs
-    return $ NamS (zip (map fst rs) es')
-  fe (RealS x) = return $ RealS x
-  fe (IntS x) = return $ IntS x
-  fe (LogS x) = return $ LogS x
-  fe (StrS x) = return $ StrS x
-  fe (CallS src) = return $ CallS src
-
 type Indexed = IndexedGeneral Int
 
 data IndexedGeneral k a = Idx k a
diff --git a/library/Morloc/Pretty.hs b/library/Morloc/Pretty.hs
index 9651f1b3..d593d8ba 100644
--- a/library/Morloc/Pretty.hs
+++ b/library/Morloc/Pretty.hs
@@ -8,10 +8,7 @@ License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
 -}
-module Morloc.Pretty
-  ( prettySAnno
-  , prettySExpr
-  ) where
+module Morloc.Pretty () where
 
 import Morloc.Data.Doc
 import Morloc.Namespace
@@ -148,45 +145,11 @@ prettyTypeU (NamU o n ps rs)
     $ block 4 (viaShow o <+> pretty n <> encloseSep "<" ">" "," (map pretty ps))
               (vsep [pretty k <+> "::" <+> prettyTypeU x | (k, x) <- rs])
 
--- For example @prettySAnnoMany id Nothing@ for the most simple printer
-prettySAnno
-  :: Foldable f
-  => (c -> Doc ann)
-  -> (g -> Doc ann)
-  -> SAnno g f c
-  -> Doc ann
-prettySAnno writeCon writeGen (SAnno e g)
-  = foldr (prettyCon writeCon writeGen) (writeGen g) e
-  where
-  prettyCon
-    :: Foldable f
-    => (c -> Doc ann)
-    -> (g -> Doc ann)
-    -> (SExpr g f c, c)
-    -> Doc ann
-    -> Doc ann
-  prettyCon fc fg (s, c) p = vsep [p, fc c, prettySExpr fc fg s]
-
-prettySExpr
-  :: Foldable f
-  => (c -> Doc ann)
-  -> (g -> Doc ann)
-  -> SExpr g f c
-  -> Doc ann
-prettySExpr fc fg x0 = case x0 of
-  UniS -> "UniS"
-  (VarS v) -> "VarS<" <> pretty v <> ">"
-  (AccS x k ) -> "AccS" <+> pretty k <+> parens (prettySAnno fc fg x)
-  (AppS x xs) -> "AppS" <+> parens (prettySAnno fc fg x) <+> tupled (map (prettySAnno fc fg) xs)
-  (LamS vs x) -> "LamS" <+> tupled (map pretty vs) <+> braces (prettySAnno fc fg x)
-  (LstS xs) -> "LstS" <+> tupled (map (prettySAnno fc fg) xs)
-  (TupS xs) -> "TupS" <+> tupled (map (prettySAnno fc fg) xs)
-  (NamS rs) -> "NamS" <+> tupled (map (\(k,x) -> pretty k <+> "=" <+> prettySAnno fc fg x) rs)
-  (RealS x) -> "RealS<" <> viaShow x <> ">"
-  (IntS x) -> "IntS<" <> viaShow x <> ">"
-  (LogS x) -> "LogS<" <> viaShow x <> ">"
-  (StrS x) -> "StrS<" <> viaShow x <> ">"
-  (CallS src) -> "CallS<" <> pretty (srcName src) <> "@" <> pretty (srcLang src) <> ">"
+instance Pretty (AnnoS g f c) where
+  pretty (AnnoS e g c) = "AnnoS"
+
+instance Pretty (ExprS g f c) where
+  pretty _ = "ExprS"
 
 instance (Pretty k, Pretty a) => Pretty (IndexedGeneral k a) where
   pretty (Idx i x) = parens (pretty i <> ":" <+> pretty x)
@@ -219,7 +182,7 @@ instance Pretty Expr where
   pretty (ImpE (Import m (Just xs) _ _)) = "import" <+> pretty m <+> tupled (map pretty xs)
   pretty (ExpE v) = "export" <+> pretty v
   pretty (VarE s) = pretty s
-  pretty (AccE e k) = parens (pretty e) <> "@" <> pretty k
+  pretty (AccE k e) = parens (pretty e) <> "@" <> pretty k
   pretty (LamE v e) = "\\" <+> pretty v <+> "->" <+> pretty e
   pretty (AnnE e ts) = parens
     $   pretty e
diff --git a/library/Morloc/Typecheck/Internal.hs b/library/Morloc/Typecheck/Internal.hs
index 71c45659..f81ac915 100644
--- a/library/Morloc/Typecheck/Internal.hs
+++ b/library/Morloc/Typecheck/Internal.hs
@@ -35,8 +35,9 @@ module Morloc.Typecheck.Internal
   , cut
   , substitute
   , rename
-  , renameSAnno
+  , renameAnnoS
   , occursCheck
+  , toExistential
   -- * subtyping
   , subtype
   -- * debugging
@@ -48,13 +49,12 @@ module Morloc.Typecheck.Internal
   , peak
   , peakGen
   , seeType
-  , showGen
   ) where
 
 import Morloc.Namespace
 import qualified Morloc.Data.Text as MT
 import Morloc.Data.Doc
-import Morloc.Pretty (prettySExpr, prettySAnno)
+import Morloc.Pretty ()
 import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Monad as MM
 
@@ -68,6 +68,12 @@ unqualify :: TypeU -> ([TVar], TypeU)
 unqualify (ForallU v (unqualify -> (vs, t))) = (v:vs, t)
 unqualify t = ([], t)
 
+toExistential :: Gamma -> TypeU -> (Gamma, TypeU)
+toExistential g0 (unqualify -> (vs0, t0)) = f g0 vs0 t0 where
+  f g [] t = (g, t)
+  f g (v:vs) t = let (g', newVar) = newvar ("cls_" <> unTVar v) g
+                 in f g' vs (substituteTVar v newVar t)
+
 class Applicable a where
   apply :: Gamma -> a -> a
 
@@ -494,36 +500,44 @@ rename g0 (ForallU v@(TV s) t0) =
 -- Unless I add N-rank types, foralls can only be on top, so no need to recurse.
 rename g t = (g, t)
 
-renameSAnno :: (Map.Map EVar EVar, Gamma) -> SAnno g Many c -> ((Map.Map EVar EVar, Gamma), SAnno g Many c)
-renameSAnno context (SAnno (Many xs) gt) =
-  let (context', es) = statefulMap renameSExpr context (map fst xs)
-  in (context', SAnno (Many (zip es (map snd xs))) gt)
+renameAnnoS :: (Map.Map EVar EVar, Gamma) -> AnnoS g ManyPoly c -> ((Map.Map EVar EVar, Gamma), AnnoS g ManyPoly c)
+renameAnnoS context (AnnoS gt ct e) =
+  let (context', e') = renameSExpr context e
+  in (context', AnnoS gt ct e')
 
-renameSExpr :: (Map.Map EVar EVar, Gamma) -> SExpr g Many c -> ((Map.Map EVar EVar, Gamma), SExpr g Many c)
+renameSExpr :: (Map.Map EVar EVar, Gamma) -> ExprS g ManyPoly c -> ((Map.Map EVar EVar, Gamma), ExprS g ManyPoly c)
 renameSExpr c0@(m, g) e0 = case e0 of
-  (VarS v) -> case Map.lookup v m of
-    (Just v') -> (c0, VarS v')
-    Nothing -> (c0, VarS v)
+  (BndS v) -> case Map.lookup v m of
+    (Just v') -> (c0, BndS v')
+    Nothing -> (c0, BndS v)
+  (VarS v (MonomorphicExpr t xs)) ->
+    let (context', xs') = statefulMap renameAnnoS c0 xs
+    in (context', VarS v (MonomorphicExpr t xs'))
+  (VarS v (PolymorphicExpr cls className t rs)) ->
+    let (ts, ass) = unzip rs
+        (context', ass') = statefulMap (statefulMap renameAnnoS) c0 ass
+        rs' = zip ts ass'
+    in (context', VarS v $ PolymorphicExpr cls className t rs')
   (LamS vs x) ->
     let (g', vs') = statefulMap (\g'' (EV v) -> evarname g'' (v <> "_e")) g vs
         m' = foldr (uncurry Map.insert) m (zip vs vs')
-        (c1, x') = renameSAnno (m', g') x
+        (c1, x') = renameAnnoS (m', g') x
     in (c1, LamS vs' x')
-  (AccS e k) ->
-    let (c1, e') = renameSAnno c0 e
-    in (c1, AccS e' k)
+  (AccS k e) ->
+    let (c1, e') = renameAnnoS c0 e
+    in (c1, AccS k e')
   (AppS e es) ->
-    let (c1, es') = statefulMap renameSAnno c0 es
-        (c2, e') = renameSAnno c1 e -- order matters here, the arguments are bound under the PARENT
+    let (c1, es') = statefulMap renameAnnoS c0 es
+        (c2, e') = renameAnnoS c1 e -- order matters here, the arguments are bound under the PARENT
     in (c2, AppS e' es')
   (LstS es) ->
-    let (c1, es') = statefulMap renameSAnno c0 es
+    let (c1, es') = statefulMap renameAnnoS c0 es
     in (c1, LstS es')
   (TupS es) ->
-    let (c1, es') = statefulMap renameSAnno c0 es
+    let (c1, es') = statefulMap renameAnnoS c0 es
     in (c1, TupS es')
   (NamS rs) ->
-    let (c1, es') = statefulMap renameSAnno c0 (map snd rs)
+    let (c1, es') = statefulMap renameAnnoS c0 (map snd rs)
     in (c1, NamS (zip (map fst rs) es'))
   e -> (c0, e)
 
@@ -560,11 +574,9 @@ leave d = do
 seeGamma :: Gamma -> MorlocMonad ()
 seeGamma g = MM.sayVVV $ nest 4 $ "Gamma:" <> line <> vsep (map pretty (gammaContext g))
 
-peak :: (Pretty c, Pretty g) => SExpr g One c -> MorlocMonad ()
-peak = insetSay . prettySExpr pretty showGen
+peak :: (Pretty c, Pretty g) => ExprS g f c -> MorlocMonad ()
+peak = insetSay . pretty
 
-peakGen :: (Pretty c, Pretty g) => SAnno g One c -> MorlocMonad ()
-peakGen = insetSay . prettySAnno pretty showGen
+peakGen :: (Pretty c, Pretty g) => AnnoS g f c -> MorlocMonad ()
+peakGen = insetSay . pretty
 
-showGen :: Pretty g => g -> MDoc
-showGen g = parens (pretty g)
diff --git a/test-suite/UnitTypeTests.hs b/test-suite/UnitTypeTests.hs
index 03ace3b9..4dc71901 100644
--- a/test-suite/UnitTypeTests.hs
+++ b/test-suite/UnitTypeTests.hs
@@ -16,7 +16,7 @@ module UnitTypeTests
 import Morloc.Frontend.Namespace
 import Text.RawString.QQ
 import Morloc (typecheckFrontend)
-import Morloc.Frontend.Typecheck (evaluateSAnnoTypes)
+import Morloc.Frontend.Typecheck (evaluateAnnoSTypes)
 import qualified Morloc.Monad as MM
 import qualified Morloc.Frontend.PartialOrder as MP
 import qualified Morloc.Typecheck.Internal as MTI
@@ -27,12 +27,12 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 -- get the toplevel general type of a typechecked expression
-gtypeof :: SAnno (Indexed TypeU) f c -> TypeU
-gtypeof (SAnno _ (Idx _ t)) = t
+gtypeof :: AnnoS (Indexed TypeU) f c -> TypeU
+gtypeof (AnnoS (Idx _ t) _ _) = t
 
-runFront :: MT.Text -> IO (Either MorlocError [SAnno (Indexed TypeU) Many Int])
+runFront :: MT.Text -> IO (Either MorlocError [AnnoS (Indexed TypeU) Many Int])
 runFront code = do
-  ((x, _), _) <- MM.runMorlocMonad Nothing 0 emptyConfig (typecheckFrontend Nothing (Code code) >>= mapM evaluateSAnnoTypes)
+  ((x, _), _) <- MM.runMorlocMonad Nothing 0 emptyConfig (typecheckFrontend Nothing (Code code) >>= mapM evaluateAnnoSTypes)
   return x
 
 emptyConfig =  Config

From 864a5911b30c92caf9e6971780319ec07591896d Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 4 Feb 2024 13:05:01 -0500
Subject: [PATCH 09/14] All tests pass

The prior commit actually was correct, it was my test that was wrong.
Well, that and uninformative error messages. Handing incorrect code is
the vast hole in my language -- there are so many more ways to be wrong
than right -- for now I just blame it all on the user. Maybe that is way
I don't have any users? No, that isn't the reason. No one has ventured
far enough into the morloc labyrinth to step on the glass I've strewn on
the ground. Except for me, of course, I've scampered all over the glass.

The typeclass handling code is actually quite intuitive and beautiful.
All instances are checked, so there should be no room for lurking
invalid but unused code, and nothing is checked more than once. All the
checking is elegant with no hacky bits. I like it. And typeclasses are
fully considered and evaluated away in the frontend typechecker, so no
new complexity is added to the backend.

Next up, remove all the special handling for the packers.
---
 test-suite/golden-tests/typeclasses-2/Makefile | 6 +++---
 test-suite/golden-tests/typeclasses-2/exp.txt  | 4 ++--
 test-suite/golden-tests/typeclasses-2/main.loc | 4 ++--
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/test-suite/golden-tests/typeclasses-2/Makefile b/test-suite/golden-tests/typeclasses-2/Makefile
index a9154420..5d49b9c6 100644
--- a/test-suite/golden-tests/typeclasses-2/Makefile
+++ b/test-suite/golden-tests/typeclasses-2/Makefile
@@ -1,8 +1,8 @@
 all:
 	rm -f obs.txt
 	morloc make -v main.loc > log
-	./nexus.py foo '"a"' '"b"' > obs.txt
-	./nexus.py bar 6 5 >> obs.txt
+	./nexus.py paste '["a","b"]' > obs.txt
+	./nexus.py sum '[1,2,3]' >> obs.txt
 
 clean:
-	rm -f nexus* pool*
+	rm -rf nexus* pool* __pycache__ y z
diff --git a/test-suite/golden-tests/typeclasses-2/exp.txt b/test-suite/golden-tests/typeclasses-2/exp.txt
index ea334e43..63ea1372 100644
--- a/test-suite/golden-tests/typeclasses-2/exp.txt
+++ b/test-suite/golden-tests/typeclasses-2/exp.txt
@@ -1,2 +1,2 @@
-"abyolo"
-17
+"ab"
+6
diff --git a/test-suite/golden-tests/typeclasses-2/main.loc b/test-suite/golden-tests/typeclasses-2/main.loc
index 63fc591c..40be4508 100644
--- a/test-suite/golden-tests/typeclasses-2/main.loc
+++ b/test-suite/golden-tests/typeclasses-2/main.loc
@@ -33,8 +33,8 @@ source Cpp from "foo.hpp" ("fold")
 source Py from "foo.py" ("fold")
 fold :: (b -> a -> b) -> b -> [a] -> b
 
-sum :: [Real] -> Real
+sum :: [Int] -> Int
 sum = fold op empty
 
-paste :: [String] -> String
+paste :: [Str] -> Str
 paste = fold op empty

From 0d9025fb54a201eae9a7ac3569d3382ccf988846 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 4 Feb 2024 15:18:40 -0500
Subject: [PATCH 10/14] Resolve all pedantic warnings

I merged the Error and PartialOrder modules into Namespace. This avoids
the orphan instance warnings by declaring all typeclass instances in the
module where the types are defined. I am not entirely happy with this.
---
 ChangeLog.md                                  |    6 +
 executable/Main.hs                            |    2 +-
 executable/Subcommands.hs                     |    5 +-
 executable/UI.hs                              |    8 +-
 library/Morloc/CodeGenerator/Generate.hs      |   61 +-
 .../Morloc/CodeGenerator/Grammars/Common.hs   |   14 +-
 .../Morloc/CodeGenerator/Grammars/Macro.hs    |    4 +-
 .../CodeGenerator/Grammars/Translator/Cpp.hs  |   30 +-
 .../Grammars/Translator/PseudoCode.hs         |    3 +-
 .../Grammars/Translator/Python3.hs            |    6 +-
 .../CodeGenerator/Grammars/Translator/R.hs    |   20 +-
 .../Translator/Source/CppInternals.hs         |   16 +-
 library/Morloc/CodeGenerator/Infer.hs         |    6 +-
 library/Morloc/CodeGenerator/Namespace.hs     |   48 +-
 library/Morloc/CodeGenerator/Nexus.hs         |    9 +-
 library/Morloc/CodeGenerator/Serial.hs        |   14 +-
 library/Morloc/Config.hs                      |   21 +-
 library/Morloc/Data/Annotated.hs              |    2 +-
 library/Morloc/Data/Bifoldable.hs             |   12 +-
 library/Morloc/Data/Bifunctor.hs              |    4 +-
 library/Morloc/Data/DAG.hs                    |   19 +-
 library/Morloc/Data/Map/Extra.hs              |    5 +-
 library/Morloc/Data/Rose.hs                   |    4 +-
 library/Morloc/Data/Text.hs                   |   11 +-
 library/Morloc/Error.hs                       |  139 ---
 library/Morloc/Frontend/AST.hs                |    2 +-
 library/Morloc/Frontend/Lexer.hs              |   34 +-
 library/Morloc/Frontend/Namespace.hs          |    8 +-
 library/Morloc/Frontend/Parser.hs             |   32 +-
 library/Morloc/Frontend/PartialOrder.hs       |  115 --
 library/Morloc/Frontend/Restructure.hs        |   14 +-
 library/Morloc/Frontend/Treeify.hs            |   61 +-
 library/Morloc/Frontend/Typecheck.hs          |   62 +-
 library/Morloc/Internal.hs                    |   18 +-
 library/Morloc/Language.hs                    |    4 +
 library/Morloc/Module.hs                      |   33 +-
 library/Morloc/Monad.hs                       |   27 +-
 library/Morloc/Namespace.hs                   | 1080 ++++++++++++-----
 library/Morloc/Pretty.hs                      |  224 ----
 library/Morloc/ProgramBuilder/Build.hs        |    4 +-
 library/Morloc/System.hs                      |    4 +-
 library/Morloc/TypeEval.hs                    |   11 +-
 library/Morloc/Typecheck/Internal.hs          |   21 +-
 test-suite/UnitTypeTests.hs                   |   61 +-
 44 files changed, 1118 insertions(+), 1166 deletions(-)
 delete mode 100644 library/Morloc/Error.hs
 delete mode 100644 library/Morloc/Frontend/PartialOrder.hs
 delete mode 100644 library/Morloc/Pretty.hs

diff --git a/ChangeLog.md b/ChangeLog.md
index a9457a15..6c0f076b 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -57,6 +57,12 @@ handling for several very different languages (proofs-of-concept).
  - [ ] Update Hackage release
  - [ ] Ensure github actions passes
 
+
+0.44.0 [2024.02.xx]
+-------------------
+
+Ad hoc polymorphism with type-classes
+
 0.43.0 [2024.01.14]
 -------------------
 
diff --git a/executable/Main.hs b/executable/Main.hs
index 4dbb3078..fc7973c0 100644
--- a/executable/Main.hs
+++ b/executable/Main.hs
@@ -1,7 +1,7 @@
 module Main where
 
 import Subcommands (runMorloc)
-import UI 
+import UI
 import Options.Applicative
 
 main :: IO ()
diff --git a/executable/Subcommands.hs b/executable/Subcommands.hs
index 10479ed1..60e43916 100644
--- a/executable/Subcommands.hs
+++ b/executable/Subcommands.hs
@@ -21,7 +21,6 @@ import qualified Morloc.Frontend.API as F
 import qualified Morloc.Data.GMap as GMap
 import Morloc.CodeGenerator.Namespace (SerialManifold(..))
 import Morloc.CodeGenerator.Grammars.Translator.PseudoCode (pseudocodeSerialManifold)
-import Morloc.Pretty ()
 import Morloc.Data.Doc
 import Text.Megaparsec.Error (errorBundlePretty)
 import qualified Data.Map as Map
@@ -128,7 +127,7 @@ writeTerm s i typeDoc =
 
 writeTypecheckOutput :: Int -> ((Either MorlocError [(Lang, [SerialManifold])], [MT.Text]), MorlocState) -> MDoc
 writeTypecheckOutput _ ((Left e, _), _) = pretty e
-writeTypecheckOutput _ ((Right pools, _), _) = vsep $ map (uncurry writePool) pools 
+writeTypecheckOutput _ ((Right pools, _), _) = vsep $ map (uncurry writePool) pools
 
 writePool :: Lang -> [SerialManifold] -> MDoc
 writePool lang manifolds = pretty lang <+> "pool:" <> "\n" <> vsep (map pseudocodeSerialManifold manifolds) <> "\n"
@@ -146,4 +145,4 @@ cmdDump args _ config = do
 prettyDAG :: DAG MVar e ExprI -> MDoc
 prettyDAG m0 = vsep (map prettyEntry (Map.toList m0)) where
   prettyEntry :: (MVar, (ExprI, [(MVar, e)])) -> MDoc
-  prettyEntry (k, (n, _)) = block 4 (pretty k) (vsep [pretty n]) 
+  prettyEntry (k, (n, _)) = block 4 (pretty k) (vsep [pretty n])
diff --git a/executable/UI.hs b/executable/UI.hs
index 7f0b7eab..4b757c68 100644
--- a/executable/UI.hs
+++ b/executable/UI.hs
@@ -43,7 +43,7 @@ data MakeCommand = MakeCommand
 
 makeCommandParser :: Parser MakeCommand
 makeCommandParser = MakeCommand
-  <$> optExpression 
+  <$> optExpression
   <*> optConfig
   <*> optVerbose
   <*> optVanilla
@@ -70,7 +70,7 @@ makeInstallParser = InstallCommand
   <*> optVanilla
   <*> optModuleName
 
-installSubcommand :: Mod CommandFields CliCommand 
+installSubcommand :: Mod CommandFields CliCommand
 installSubcommand = command "install" (info (CmdInstall <$> makeInstallParser) (progDesc "install a morloc module"))
 
 
@@ -96,12 +96,12 @@ makeTypecheckParser = TypecheckCommand
   <*> optRealize
   <*> optScript
 
-typecheckSubcommand :: Mod CommandFields CliCommand 
+typecheckSubcommand :: Mod CommandFields CliCommand
 typecheckSubcommand =
   command "typecheck" (info (CmdTypecheck <$> makeTypecheckParser) (progDesc "typecheck a morloc program"))
 
 
-dumpSubcommand :: Mod CommandFields CliCommand 
+dumpSubcommand :: Mod CommandFields CliCommand
 dumpSubcommand =
   command "dump" (info (CmdDump <$> makeDumpParser) (progDesc "dump parsed code"))
 
diff --git a/library/Morloc/CodeGenerator/Generate.hs b/library/Morloc/CodeGenerator/Generate.hs
index 26994bd0..08ee0770 100644
--- a/library/Morloc/CodeGenerator/Generate.hs
+++ b/library/Morloc/CodeGenerator/Generate.hs
@@ -18,7 +18,6 @@ module Morloc.CodeGenerator.Generate
 ) where
 
 import Morloc.CodeGenerator.Namespace
-import Morloc.Pretty ()
 import Morloc.Data.Doc
 import qualified Data.Map as Map
 import qualified Morloc.Config as MC
@@ -26,7 +25,6 @@ import qualified Morloc.Data.Text as MT
 import qualified Morloc.Language as Lang
 import qualified Morloc.Monad as MM
 import qualified Morloc.CodeGenerator.Nexus as Nexus
-import Morloc.Frontend.Typecheck (peakSExpr)
 import Morloc.CodeGenerator.Infer
 
 import qualified Morloc.CodeGenerator.Grammars.Translator.Cpp as Cpp
@@ -111,12 +109,12 @@ realize
   :: AnnoS (Indexed Type) Many Int
   -> MorlocMonad (Either (AnnoS (Indexed Type) One ())
                          (AnnoS (Indexed Type) One (Indexed Lang)))
-realize s0@(AnnoS (Idx i0 t0) _ _) = do
+realize s0 = do
   e@(AnnoS _ li _) <- scoreAnnoS [] s0 >>= collapseAnnoS Nothing |>> removeVarS
   case li of
     (Idx _ Nothing) -> makeGAST e |>> Left
     (Idx _ _) -> Right <$> propagateDown e
-  where 
+  where
 
   -- | Depth first pass calculating scores for each language. Alternates with
   -- scoresSExpr.
@@ -162,10 +160,10 @@ realize s0@(AnnoS (Idx i0 t0) _ _) = do
     xs' <- mapM (scoreAnnoS (unique $ map fst scores)) xs
 
     -- [[(Lang, Int)]] : where Lang is unique within each list and Int is minimized
-    let pairss = [minPairs xs' | AnnoS _ (Idx _ xs') _ <- xs']
+    let pairss = [minPairs pairs | AnnoS _ (Idx _ pairs) _ <- xs']
 
         {- find the best score for each language supported by function f
-          
+
            Below is the cost function where
             l1: the language of the ith calling function implementation
             s1: the score of the ith implementation
@@ -467,7 +465,7 @@ generalSerial x0@(AnnoS (Idx i t) _ _) = do
     generalSerial' base ps (AnnoS _ _(BndS (EV v))) =
       return $ base { commandSubs = [(ps, v, [])] }
     -- bad states
-    generalSerial' _ _ (AnnoS _ _ (VarS v _)) = error $ "VarS should have been removed in the prior step, found: " <> show v 
+    generalSerial' _ _ (AnnoS _ _ (VarS v _)) = error $ "VarS should have been removed in the prior step, found: " <> show v
     generalSerial' NexusCommand{} _ (AnnoS _ _ (CallS _)) = error "Functions should not occur here, observed AppS"
     generalSerial' NexusCommand{} _ (AnnoS _ _ (AppS _ _)) = error "Functions should not occur here, observed AppS"
 
@@ -568,7 +566,7 @@ applyLambdas (AnnoS g1 _ (AppS (AnnoS _ _ (LamS [] (AnnoS _ c2 e))) [])) = apply
 applyLambdas (AnnoS g1 _ (AppS (AnnoS _ c2 e) [])) = applyLambdas $ AnnoS g1 c2 e
 
 -- substitute applied lambdas
-applyLambdas 
+applyLambdas
   (AnnoS i1 tb1
     ( AppS
       ( AnnoS
@@ -664,9 +662,9 @@ parameterize'
 -- primitives, no arguments are required for a primitive, so empty lists
 parameterize' _ (AnnoS g c UniS) = return $ AnnoS g (c, []) UniS
 parameterize' _ (AnnoS g c (RealS x)) = return (AnnoS g (c, []) (RealS x))
-parameterize' _ (AnnoS g c (IntS x))  = return (AnnoS g (c, []) (IntS x)) 
-parameterize' _ (AnnoS g c (LogS x))  = return (AnnoS g (c, []) (LogS x)) 
-parameterize' _ (AnnoS g c (StrS x))  = return (AnnoS g (c, []) (StrS x)) 
+parameterize' _ (AnnoS g c (IntS x))  = return (AnnoS g (c, []) (IntS x))
+parameterize' _ (AnnoS g c (LogS x))  = return (AnnoS g (c, []) (LogS x))
+parameterize' _ (AnnoS g c (StrS x))  = return (AnnoS g (c, []) (StrS x))
 parameterize' args (AnnoS g c (BndS v)) = do
   let args' = [r | r@(Arg _ v') <- args, v' == v]
   return $ AnnoS g (c, args') (BndS v)
@@ -789,12 +787,12 @@ expressDefault e@(AnnoS (Idx midx t) (Idx cidx lang, args) _)
 expressPolyExpr :: Lang -> Indexed Type -> AnnoS (Indexed Type) One (Indexed Lang, [Arg EVar]) -> MorlocMonad PolyExpr
 -- these cases will include partially applied functions and explicit lambdas
 -- the former is transformed into the latter in the frontend typechecker
-expressPolyExpr parentLang pc
+expressPolyExpr parentLang _
   (AnnoS (Idx midx lamType@(FunT lamInputTypes lamOutType)) (Idx cidxLam _, lamArgs)
     (LamS vs
       (AnnoS (Idx _ appType) (Idx cidxApp appLang, appArgs)
         (AppS
-          (AnnoS callTypeI@(Idx _ callType@(FunT callInputTypes _)) (Idx cidxCall callLang, _)
+          (AnnoS callTypeI@(Idx _ (FunT callInputTypes _)) (Idx _ callLang, _)
             (CallS src)) xs))))
 
   ----------------------------------------------------------------------------------------
@@ -1235,7 +1233,7 @@ expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (RealS x )) = return
 expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (IntS x  )) = return $ PolyInt  (Idx cidx v) x
 expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (LogS x  )) = return $ PolyLog  (Idx cidx v) x
 expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (StrS x  )) = return $ PolyStr  (Idx cidx v) x
-expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _) (UniS    )) = return $ PolyNull (Idx cidx v)
+expressPolyExpr _ _ (AnnoS (Idx _ (VarT v)) (Idx cidx _, _)  UniS     ) = return $ PolyNull (Idx cidx v)
 
 -- record access
 expressPolyExpr _ pc (AnnoS _ _ (AccS key record@(AnnoS (Idx _ (NamT o v _ rs)) (Idx cidx lang, _) _))) = do
@@ -1303,7 +1301,7 @@ segment (PolyHead lang m0 args0 e0) = do
             <> "\n  topExpr language:" <+> pretty lang
             <> "\n  topExpr: " <+> pretty topExpr
             <> "\n  heads:" <+> list (map pretty heads)
-  
+
   return (MonoHead lang m0 args0 topExpr : heads)
 
 segmentExpr
@@ -1463,7 +1461,7 @@ serialize (MonoHead lang m0 args0 e0) = do
       ne1 <- nativeExpr m e1
       NativeLetS i ne1 <$> serialExpr m e2
   serialExpr _ (MonoLetVar t i) = do
-    t' <- inferType t 
+    t' <- inferType t
     return $ LetVarS (Just t') i
   serialExpr m (MonoReturn e) = ReturnS <$> serialExpr m e
   serialExpr _ (MonoApp (MonoPoolCall t m docs contextArgs) es) = do
@@ -1659,7 +1657,7 @@ class IsSerializable a where
 instance IsSerializable SerialExpr where
   serialLet = SerialLetS
   nativeLet = NativeLetS
-  
+
 instance IsSerializable NativeExpr where
   serialLet = SerialLetN
   nativeLet = NativeLetN
@@ -1757,16 +1755,16 @@ wireSerial lang sm0@(SerialManifold m0 _ _ _) = foldSerialManifoldM fm sm0 |>> s
 
   letWrap :: (IsSerializable e, HasRequest t, MayHaveTypeF t)
           => Int -> ManifoldForm (Or TypeS TypeF) t -> Map.Map Int Request -> e -> MorlocMonad e
-  letWrap m0 form0 req0 e0 = foldlM wrapAsNeeded e0 (Map.toList req0) where
+  letWrap m form0 req0 e0 = foldlM wrapAsNeeded e0 (Map.toList req0) where
 
     formMap = manifoldToMap form0
 
     wrapAsNeeded :: IsSerializable e => e -> (Int, Request) -> MorlocMonad e
     wrapAsNeeded e (i, req) = case (req, Map.lookup i formMap) of
-      (SerialContent,          Just (NativeContent, Just t)) -> serialLet i <$> serializeS "wan 1" m0 t (BndVarN t i) <*> pure e
-      (NativeAndSerialContent, Just (NativeContent, Just t)) -> serialLet i <$> serializeS "wan 2" m0 t (BndVarN t i) <*> pure e
-      (NativeContent,          Just (SerialContent, Just t)) -> nativeLet i <$> naturalizeN "wan 3" m0 lang t (BndVarS (Just t) i) <*> pure e
-      (NativeAndSerialContent, Just (SerialContent, Just t)) -> nativeLet i <$> naturalizeN "wan 4" m0 lang t (BndVarS (Just t) i) <*> pure e
+      (SerialContent,          Just (NativeContent, Just t)) -> serialLet i <$> serializeS "wan 1" m t (BndVarN t i) <*> pure e
+      (NativeAndSerialContent, Just (NativeContent, Just t)) -> serialLet i <$> serializeS "wan 2" m t (BndVarN t i) <*> pure e
+      (NativeContent,          Just (SerialContent, Just t)) -> nativeLet i <$> naturalizeN "wan 3" m lang t (BndVarS (Just t) i) <*> pure e
+      (NativeAndSerialContent, Just (SerialContent, Just t)) -> nativeLet i <$> naturalizeN "wan 4" m lang t (BndVarS (Just t) i) <*> pure e
       _ -> return e
 
   manifoldToMap :: (HasRequest t, MayHaveTypeF t) => ManifoldForm (Or TypeS TypeF) t -> Map.Map Int (Request, Maybe TypeF)
@@ -1829,27 +1827,12 @@ instance Semigroup Request where
 data SerializationState = Serialized | Unserialized
   deriving(Show, Eq, Ord)
 
-class HasSerializationState a where
-  isSerialized :: a -> SerializationState
-
-instance HasSerializationState SerialExpr where
-  isSerialized _ = Serialized
-
-instance HasSerializationState SerialManifold where
-  isSerialized _ = Serialized
-
-instance HasSerializationState NativeExpr where
-  isSerialized _ = Unserialized
-
-instance HasSerializationState NativeManifold where
-  isSerialized _ = Unserialized
-
 
 -- Sort manifolds into pools. Within pools, group manifolds into call sets.
 pool :: [SerialManifold] -> [(Lang, [SerialManifold])]
 pool es =
     -- [SerialManifold] --> [(Lang, [(Int, SerialManifold)])]
-    let (langs, indexedSegments) = unzip . groupSort . map (\x@(SerialManifold i lang _ _) -> (lang, (i, x))) $ es 
+    let (langs, indexedSegments) = unzip . groupSort . map (\x@(SerialManifold i lang _ _) -> (lang, (i, x))) $ es
         {-
         Each of the `SerialManifold` values is represents a single subtree of the
         program and may thus contain many nested manifolds. Each is thus the root
@@ -1882,7 +1865,7 @@ findSources ms = unique <$> concatMapM (foldSerialManifoldM fm) ms
     , opNativeManifoldM = nativeManifoldSrcs
     , opSerialManifoldM = nativeSerialSrcs
     }
-  
+
   nativeExprSrcs (AppSrcN_ _ src xss) = return (src : concat xss)
   nativeExprSrcs (SrcN_ _ src) = return [src]
   nativeExprSrcs (DeserializeN_ _ s xs) = return $ serialASTsources s <> xs
diff --git a/library/Morloc/CodeGenerator/Grammars/Common.hs b/library/Morloc/CodeGenerator/Grammars/Common.hs
index 5e0c4960..f76c993d 100644
--- a/library/Morloc/CodeGenerator/Grammars/Common.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Common.hs
@@ -96,7 +96,7 @@ makeManifoldIndexer getId putId = defaultValue
     putId originalManifoldIndex
     return x'
 
-  surroundSM f sm@(SerialManifold i _ _ _) = descend i sm f 
+  surroundSM f sm@(SerialManifold i _ _ _) = descend i sm f
 
   surroundNM f nm@(NativeManifold i _ _ _) = descend i nm f
 
@@ -152,9 +152,9 @@ instance Dependable SerialExpr where
         -- _ -> error "This type must be serialized"
       return $ D (LetVarS t i) ((i, Left e) : deps)
 
-  isAtomic (LetVarS _ _) = True 
-  isAtomic (BndVarS _ _) = True 
-  isAtomic (ReturnS _) = True 
+  isAtomic (LetVarS _ _) = True
+  isAtomic (BndVarS _ _) = True
+  isAtomic (ReturnS _) = True
   isAtomic _ = False
 
 
@@ -243,12 +243,12 @@ maxIndex = (+1) . runIdentity . foldSerialManifoldM fm
     , opNativeArgM = return . foldlNA max 0
     }
 
-  findSerialManifoldIndices :: Monad m => SerialManifold_ Int -> m Int 
+  findSerialManifoldIndices :: Monad m => SerialManifold_ Int -> m Int
   findSerialManifoldIndices (SerialManifold_ _ _ form bodyMax) = do
     let formIndices = abilist const const form
     return $ foldl max bodyMax formIndices
 
-  findNativeManifoldIndices :: Monad m => NativeManifold_ Int -> m Int 
+  findNativeManifoldIndices :: Monad m => NativeManifold_ Int -> m Int
   findNativeManifoldIndices (NativeManifold_ _ _ form bodyMax) = do
     let formIndices = abilist const const form
     return $ foldl max bodyMax formIndices
@@ -290,4 +290,4 @@ translateManifold makeFunction makeLambda m form (PoolDocs completeManifolds bod
       }
   where
     asArgs :: [Arg (Or TypeS TypeF)] -> [Arg TypeM]
-    asArgs rs = concat [[Arg i t | t <- bilist typeMof typeMof orT] | (Arg i orT) <- rs] 
+    asArgs rs = concat [[Arg i t | t <- bilist typeMof typeMof orT] | (Arg i orT) <- rs]
diff --git a/library/Morloc/CodeGenerator/Grammars/Macro.hs b/library/Morloc/CodeGenerator/Grammars/Macro.hs
index fdcadea6..cefeaeb4 100644
--- a/library/Morloc/CodeGenerator/Grammars/Macro.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Macro.hs
@@ -23,9 +23,7 @@ import qualified Text.Megaparsec.Char.Lexer as L
 
 type Parser a = CMS.StateT ParserState (Parsec Void MT.Text) a
 
-data ParserState = ParserState {
-    stateParameters :: [MT.Text]
-}
+newtype ParserState = ParserState { stateParameters :: [MT.Text] }
 
 expandMacro :: MT.Text -> [MT.Text] -> MT.Text
 expandMacro t [] = t
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs b/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
index b52eae06..bb299a01 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
@@ -17,7 +17,7 @@ Stability   : experimental
 -}
 
 module Morloc.CodeGenerator.Grammars.Translator.Cpp
-  ( 
+  (
     translate
   , preprocess
   ) where
@@ -72,7 +72,7 @@ instance HasCppType NativeManifold where
 
 instance {-# OVERLAPPABLE #-} HasTypeF e => HasCppType e where
   cppTypeOf = f . typeFof where
-    f (UnkF (FV _ x)) = return $ pretty x 
+    f (UnkF (FV _ x)) = return $ pretty x
     f (VarF (FV _ x)) = return $ pretty x
     f (FunF ts t) = do
       t' <- f t
@@ -152,9 +152,6 @@ preprocess = return . invertSerialManifold
 
 translate :: [Source] -> [SerialManifold] -> MorlocMonad Script
 translate srcs es = do
-  -- -- diagnostics
-  -- liftIO . putDoc . vsep $ "-- C++ translation --" : map pretty es
-
   -- generate code for serialization
   serializationBoilerplate <- generateSourcedSerializers es
 
@@ -207,7 +204,7 @@ makeTheMaker srcs = do
   return [cmd]
 
 serialType :: MDoc
-serialType = pretty $ ML.serialType CppLang 
+serialType = pretty $ ML.serialType CppLang
 
 makeSignature :: SerialManifold -> CppTranslator [MDoc]
 makeSignature = foldWithSerialManifoldM fm where
@@ -328,7 +325,7 @@ serialize nativeExpr s0 = do
     construct _ (SerialObject NamObject _ _ _) = error "C++ object serialization not yet implemented"
     construct _ (SerialObject NamTable _ _ _) = error "C++ table serialization not yet implemented"
 
-    construct _ _ = error "Unreachable" 
+    construct _ _ = error "Unreachable"
 
 -- reverse of serialize, parameters are the same
 deserialize :: MDoc -> MDoc -> SerialAST -> CppTranslator (MDoc, [MDoc])
@@ -449,7 +446,7 @@ translateSegment m0 = do
   makeSerialExpr _ (LetVarS_ _ i) = return $ PoolDocs [] (svarNamer i) [] []
   makeSerialExpr _ (BndVarS_ _ i) = return $ PoolDocs [] (svarNamer i) [] []
   makeSerialExpr _ (SerializeS_ s e) = do
-    se <- serialize (poolExpr e) s 
+    se <- serialize (poolExpr e) s
     return $ mergePoolDocs (\_ -> poolExpr se) [e, se]
   makeSerialExpr _ _ = error "Unreachable"
 
@@ -458,7 +455,7 @@ translateSegment m0 = do
     return $ mergePoolDocs ((<>) (pretty $ srcName src) . tupled) es
   makeNativeExpr _ (ManN_ call) = return call
   makeNativeExpr _ (ReturnN_ e) =
-    return $ e {poolExpr = "return" <> parens (poolExpr e) <> ";"} 
+    return $ e {poolExpr = "return" <> parens (poolExpr e) <> ";"}
   makeNativeExpr _ (SerialLetN_ i sa nb) = return $ makeLet svarNamer i serialType sa nb
   makeNativeExpr (NativeLetN _ (typeFof -> t1) _) (NativeLetN_ i na nb) = makeLet nvarNamer i <$> cppTypeOf t1 <*> pure na <*> pure nb
   makeNativeExpr _ (LetVarN_ _ i) = return $ PoolDocs [] (nvarNamer i) [] []
@@ -530,10 +527,10 @@ makeManifold callIndex form manifoldType e = do
 
   makeManifoldCall
     :: HasTypeM t
-    => ManifoldForm (Or TypeS TypeF) t -> CppTranslator MDoc 
+    => ManifoldForm (Or TypeS TypeF) t -> CppTranslator MDoc
   makeManifoldCall (ManifoldFull rs) = do
     let args = map argNamer (typeMofRs rs)
-    return $ mname <> tupled args 
+    return $ mname <> tupled args
   makeManifoldCall (ManifoldPass vs) = do
     typestr <- stdFunction (returnType manifoldType) (map (fmap typeMof) vs)
     return $ typestr <> parens mname
@@ -574,10 +571,10 @@ makeManifold callIndex form manifoldType e = do
         let tryBody = block 4 "try" body
             throwStatement = vsep
               [ [idoc|std::string error_message = "Error in m#{pretty callIndex} " + std::string(e.what());|]
-              , [idoc|std::cerr << error_message << std::endl;|] 
+              , [idoc|std::cerr << error_message << std::endl;|]
               , [idoc|throw std::runtime_error(error_message);|]
               ]
-            catchBody = block 4 "catch (const std::exception& e)" throwStatement 
+            catchBody = block 4 "catch (const std::exception& e)" throwStatement
             tryCatchBody = tryBody <+> catchBody
         return . Just . block 4 decl . vsep $
           [ {- can add diagnostic statements here -}
@@ -623,7 +620,7 @@ makeDispatch ms = block 4 "switch(std::stoi(argv[1]))" (vsep (map makeCase ms))
 
 typeParams :: [(Maybe TypeF, TypeF)] -> CppTranslator MDoc
 typeParams ts = do
-  ds <- mapM cppTypeOf [t | (Nothing, t) <- ts] 
+  ds <- mapM cppTypeOf [t | (Nothing, t) <- ts]
   return $
     if null ds
       then ""
@@ -708,7 +705,7 @@ generateAnonymousStructs = do
         rname = recName rec
         rtype = rname <> recordTemplate [v | (v, (_, Nothing)) <- rs']
 
-    let fieldNames = [k | (_, (k, _)) <- rs'] 
+    let fieldNames = [k | (_, (k, _)) <- rs']
 
     fieldTypes <- mapM (\(t, v) -> maybeM t cppTypeOf v) [(t', v') | (t', (_, v')) <- rs']
 
@@ -719,7 +716,7 @@ generateAnonymousStructs = do
         deserialDecl = deserialHeaderTemplate params rtype
         serializer = serializerTemplate params rtype fields
         deserializer = deserializerTemplate False params rtype fields
-    
+
 
     return ([structDecl, serialDecl, deserialDecl], [serializer, deserializer])
 
@@ -903,6 +900,7 @@ bool deserialize(const std::string json, size_t &i, #{rtype} &x){
            else let obj = encloseSep "{" "}" "," values
                 in [idoc|#{rtype} y = #{obj}; x = y;|]
 
+parseComma :: Doc ann
 parseComma = [idoc|
 if(! match(json, ",", i))
     throw 800;
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs b/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
index d807392c..4f657465 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
@@ -56,7 +56,7 @@ prettyFoldManifold = FoldWithManifoldM
     makeNativeExpr :: Monad m => NativeExpr -> NativeExpr_ PoolDocs PoolDocs PoolDocs PoolDocs PoolDocs -> m PoolDocs
     makeNativeExpr _ (AppSrcN_ _ (pretty . srcName -> functionName) xs) =
       return $ mergePoolDocs ((<>) functionName . tupled) xs
-    makeNativeExpr _ (ManN_ call) = return call 
+    makeNativeExpr _ (ManN_ call) = return call
     makeNativeExpr _ (ReturnN_ x) =
       return $ x { poolExpr = "ReturnN(" <> poolExpr x <> ")" }
     makeNativeExpr _ (SerialLetN_ i x1 x2) = return $ makeLet letNamerS "SerialLetN" i x1 x2
@@ -117,6 +117,7 @@ prettyFoldManifold = FoldWithManifoldM
     argName (Arg i _) = bndNamerS i
 
 
+prettyThing :: (p -> MI.Identity PoolDocs) -> p -> Doc ()
 prettyThing f a =
   let e = MI.runIdentity $ f a
   in vsep . punctuate line $ poolPriorExprs e <> poolCompleteManifolds e
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs b/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
index 85394a38..4f0d7950 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
@@ -133,12 +133,12 @@ serialize v0 s0 = do
       let accessField = selectAccessor namType constructor
       (befores, ss') <- mapAndUnzipM (\(key, s) -> serialize' (accessField v (pretty key)) s) rs
       v' <- helperNamer <$> newIndex
-      let entries = zipWith (\key val -> pretty key <> "=" <> val)
+      let entries = zipWith (\key value -> pretty key <> "=" <> value)
                             (map fst rs) ss'
           decl = [idoc|#{v'} = dict#{tupled (entries)}|]
       return (concat befores ++ [decl], v')
 
-    construct _ _ = error "Unreachable" 
+    construct _ _ = error "Unreachable"
 
 
 
@@ -188,7 +188,7 @@ deserialize v0 s0
       let accessField = selectAccessor namType constructor
       (ss', befores) <- mapAndUnzipM (\(k, s) -> check (accessField v (pretty k)) s) rs
       v' <- helperNamer <$> newIndex
-      let entries = zipWith (\key val -> pretty key <> "=" <> val)
+      let entries = zipWith (\key value -> pretty key <> "=" <> value)
                             (map fst rs) ss'
           decl = [idoc|#{v'} = #{pretty constructor}#{tupled entries}|]
       return (v', concat befores ++ [decl])
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/R.hs b/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
index 88e654db..4a7c1637 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
@@ -10,7 +10,7 @@ Stability   : experimental
 -}
 
 module Morloc.CodeGenerator.Grammars.Translator.R
-  ( 
+  (
     translate
   , preprocess
   ) where
@@ -86,7 +86,7 @@ serialize v0 s0 = do
       serialize' [idoc|#{unpacker}(#{v})|] s
 
     construct v (SerialList _ s) = do
-      idx <- newIndex 
+      idx <- newIndex
       let v' = helperNamer idx
           idxStr = pretty idx
       (before, x) <- serialize' [idoc|i#{idxStr}|] s
@@ -102,11 +102,11 @@ serialize v0 s0 = do
     construct v (SerialObject _ _ _ rs) = do
       (befores, ss') <- mapAndUnzipM (\(key, s) -> serialize' (recordAccess v (pretty key)) s) rs
       v' <- helperNamer <$> newIndex
-      let entries = zipWith (\key val -> pretty key <> "=" <> val) (map fst rs) ss'
+      let entries = zipWith (\key value -> pretty key <> "=" <> value) (map fst rs) ss'
           decl = [idoc|#{v'} <- list#{tupled entries}|]
       return (concat befores ++ [decl], v')
 
-    construct _ _ = error "Unreachable" 
+    construct _ _ = error "Unreachable"
 
 
 deserialize :: MDoc -> SerialAST -> Index (MDoc, [MDoc])
@@ -151,7 +151,7 @@ deserialize v0 s0
     construct v (SerialObject _ (FV _ constructor) _ rs) = do
       (ss', befores) <- mapAndUnzipM (\(k, s) -> check (recordAccess v (pretty k)) s) rs
       v' <- helperNamer <$> newIndex
-      let entries = zipWith (\key val -> pretty key <> "=" <> val) (map fst rs) ss'
+      let entries = zipWith (\key value -> pretty key <> "=" <> value) (map fst rs) ss'
           decl = [idoc|#{v'} <- #{pretty constructor}#{tupled entries}|]
       return (v', concat befores ++ [decl])
 
@@ -280,9 +280,9 @@ typeSchema s0 = squotes $ jsontype2rjson (serialAstToJsonType s0) where
 
 jsontype2rjson :: JsonType -> MDoc
 jsontype2rjson (VarJ v) = dquotes (pretty v)
-jsontype2rjson (ArrJ v ts) = "{" <> key <> ":" <> val <> "}" where
+jsontype2rjson (ArrJ v ts) = "{" <> key <> ":" <> value <> "}" where
   key = dquotes (pretty v)
-  val = encloseSep "[" "]" "," (map jsontype2rjson ts)
+  value = encloseSep "[" "]" "," (map jsontype2rjson ts)
 jsontype2rjson (NamJ objType rs) =
   case objType of
     (CV "data.frame") -> "{" <> dquotes "data.frame" <> ":" <> encloseSep "{" "}" "," rs' <> "}"
@@ -290,8 +290,8 @@ jsontype2rjson (NamJ objType rs) =
     _ -> encloseSep "{" "}" "," rs'
   where
   keys = map (dquotes . pretty . fst) rs
-  vals = map (jsontype2rjson . snd) rs
-  rs' = zipWith (\key val -> key <> ":" <> val) keys vals
+  values = map (jsontype2rjson . snd) rs
+  rs' = zipWith (\key value -> key <> ":" <> value) keys values
 
 makePool :: [MDoc] -> [MDoc] -> MDoc
 makePool sources manifolds = [idoc|#!/usr/bin/env Rscript
@@ -381,7 +381,7 @@ makePool sources manifolds = [idoc|#!/usr/bin/env Rscript
 
 read <- function(file)
 {
-  paste(readLines(file), collapse="\n") 
+  paste(readLines(file), collapse="\n")
 }
 
 args <- as.list(commandArgs(trailingOnly=TRUE))
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/Source/CppInternals.hs b/library/Morloc/CodeGenerator/Grammars/Translator/Source/CppInternals.hs
index c45d15fa..7d627fb4 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/Source/CppInternals.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/Source/CppInternals.hs
@@ -22,7 +22,9 @@ module Morloc.CodeGenerator.Grammars.Translator.Source.CppInternals
   ) where
 
 import Morloc.Quasi
+import Morloc.Data.Doc
 
+foreignCallFunction :: Doc ann
 foreignCallFunction = [idoc|
 std::string generateTempFilename() {
     char template_file[] = "/tmp/morloc_cpp_XXXXXX";
@@ -81,6 +83,8 @@ std::string foreign_call(
 }
 |]
 
+
+serializationHandling :: Doc ann
 serializationHandling = [idoc|
 #include <iostream>
 #include <sstream>
@@ -91,7 +95,7 @@ serializationHandling = [idoc|
 #include <iomanip>
 #include <limits>
 #include <tuple>
-#include <utility> 
+#include <utility>
 
 
 std::string serialize(bool x, bool schema);
@@ -357,7 +361,7 @@ bool deserialize(const std::string json, size_t &i, double &x){
     std::string lhs = "";
     std::string rhs = "";
     char sign = '+';
-    
+
     if(json[i] == '-'){
         sign = '-';
         i++;
@@ -371,7 +375,7 @@ bool deserialize(const std::string json, size_t &i, double &x){
     }
 
     if(lhs.size() > 0){
-        x = read_double(sign + lhs + '.' + rhs);  
+        x = read_double(sign + lhs + '.' + rhs);
         return true;
     } else {
         return false;
@@ -384,7 +388,7 @@ bool deserialize(const std::string json, size_t &i, float &x){
     std::string lhs = "";
     std::string rhs = "";
     char sign = '+';
-    
+
     if(json[i] == '-'){
         sign = '-';
         i++;
@@ -398,7 +402,7 @@ bool deserialize(const std::string json, size_t &i, float &x){
     }
 
     if(lhs.size() > 0){
-        x = read_float(sign + lhs + '.' + rhs);  
+        x = read_float(sign + lhs + '.' + rhs);
         return true;
     } else {
         return false;
@@ -479,7 +483,7 @@ bool integer_deserialize(const std::string json, size_t &i, A &x){
         sstream >> x;
         return true;
     }
-    return false; 
+    return false;
 }
 bool deserialize(const std::string json, size_t &i, int &x){
     return integer_deserialize(json, i, x);
diff --git a/library/Morloc/CodeGenerator/Infer.hs b/library/Morloc/CodeGenerator/Infer.hs
index 0f2809f0..06b0fe0d 100644
--- a/library/Morloc/CodeGenerator/Infer.hs
+++ b/library/Morloc/CodeGenerator/Infer.hs
@@ -35,7 +35,7 @@ getScope i lang = do
   return (cscope, gscope)
 
 evalGeneralStep :: Int -> TypeU -> MorlocMonad (Maybe TypeU)
-evalGeneralStep i t = do 
+evalGeneralStep i t = do
   globalMap <- MM.gets stateGeneralTypedefs
   gscope <- case GMap.lookup i globalMap of
     GMapJust scope -> return scope
@@ -109,13 +109,13 @@ inferConcreteTypeUUniversal lang generalType = do
 weave :: Scope -> TypeU -> TypeU -> Either MDoc TypeF
 weave gscope = w where
   w (VarU v1) (VarU (TV v2)) = return $ VarF (FV v1 (CV v2))
-  w (FunU ts1 t1) (FunU ts2 t2) = FunF <$> zipWithM w ts1 ts2 <*> w t1 t2 
+  w (FunU ts1 t1) (FunU ts2 t2) = FunF <$> zipWithM w ts1 ts2 <*> w t1 t2
   w (AppU t1 ts1) (AppU t2 ts2) = AppF <$> w t1 t2 <*> zipWithM w ts1 ts2
   w t1@(NamU o1 v1 ts1 rs1) t2@(NamU o2 v2 ts2 rs2)
     | o1 == o2 && length ts1 == length ts2 && length rs1 == length rs2
         = NamF o1 (FV v1 (CV (unTVar v2)))
         <$> zipWithM w ts1 ts2
-        <*> zipWithM (\ (_, t1) (k2, t2) -> (,) k2 <$> w t1 t2) rs1 rs2
+        <*> zipWithM (\ (_, t1') (k2', t2') -> (,) k2' <$> w t1' t2') rs1 rs2
     | otherwise = Left $ "failed to weave:" <+> "\n  t1:" <+> pretty t1 <+> "\n  t2:" <+> pretty t2
   w t1 t2 = case T.evaluateStep gscope t1 of
     Nothing -> Left $ "failed to weave:" <+> "\n  t1:" <+> pretty t1 <> "\n  t2:" <> pretty t2
diff --git a/library/Morloc/CodeGenerator/Namespace.hs b/library/Morloc/CodeGenerator/Namespace.hs
index c9fe8ef8..2eb6365d 100644
--- a/library/Morloc/CodeGenerator/Namespace.hs
+++ b/library/Morloc/CodeGenerator/Namespace.hs
@@ -27,7 +27,7 @@ module Morloc.CodeGenerator.Namespace
   , HasTypeM(..)
   , typeMofRs
   , typeMofForm
-  -- ** 
+  -- **
   , Arg
   , ArgGeneral(..)
   , JsonType(..)
@@ -114,7 +114,6 @@ import Morloc.Namespace
 import Data.Scientific (Scientific)
 import Data.Text (Text)
 import Morloc.Data.Doc
-import Morloc.Pretty ()
 import Control.Monad.Identity (runIdentity)
 
 -- The final types used in code generation. The language annotation is removed,
@@ -185,14 +184,11 @@ data SerialAST
   -- source code comments.
   deriving(Ord, Eq, Show)
 
-instance Pretty CVar where
-  pretty v = pretty (unCVar v)
-
 instance Pretty SerialAST where
   pretty (SerialPack v (packer, s)) = parens
     $ "SerialPack" <+> pretty v
     <+> braces (vsep [pretty packer, pretty s])
-  pretty (SerialList _ ef) = parens $ "SerialList" <+> pretty ef 
+  pretty (SerialList _ ef) = parens $ "SerialList" <+> pretty ef
   pretty (SerialTuple _ efs) = parens $ "SerialTuple" <+> tupled (map pretty efs)
   pretty (SerialObject o _ vs rs) = parens
     $ "SerialObject" <+> pretty o <+> tupled (map pretty vs)
@@ -272,7 +268,7 @@ class HasTypeS a where
 --   foo xs = zipWith add xs
 --
 -- x1 and x2 are supplied by the source function
--- 
+--
 -- #3: ManifoldPart [x1 = (runif 0 1), x2 = var "x"] [x2 : "float"]
 --   source py "foo.py" ("add", "runif")
 --   foo xs = map (add (runif 0 1)) xs
@@ -338,14 +334,14 @@ abilistM f _ (ManifoldFull xs) = mapM (annappM f) xs
 abilistM _ g (ManifoldPass xs) = mapM (annappM g) xs
 abilistM f g (ManifoldPart xs ys) = (<>) <$> mapM (annappM f) xs <*> mapM (annappM g) ys
 
-abilist :: (Int -> a -> c) -> (Int -> b -> c) -> ManifoldForm a b -> [c] 
+abilist :: (Int -> a -> c) -> (Int -> b -> c) -> ManifoldForm a b -> [c]
 abilist f g = runIdentity . abilistM (return2 f) (return2 g)
 
 abiappendM :: (Monad m, Monoid c) => (Int -> a -> m c) -> (Int -> b -> m c) -> ManifoldForm a b -> m c
 abiappendM f g = fmap mconcat . abilistM f g
 
 abiappend :: (Monoid c) => (Int -> a -> c) -> (Int -> b -> c) -> ManifoldForm a b -> c
-abiappend f g = runIdentity . abiappendM (return2 f) (return2 g) 
+abiappend f g = runIdentity . abiappendM (return2 f) (return2 g)
 
 instance Pretty FVar where
     pretty (FV _ c) = pretty c
@@ -507,7 +503,7 @@ foldlNE f b (SerialLetN_   _ x1 x2) = foldl f b [x1, x2]
 foldlNE f b (NativeLetN_   _ x1 x2) = foldl f b [x1, x2]
 foldlNE _ b (LetVarN_      _ _) = b
 foldlNE _ b (BndVarN_      _ _) = b
-foldlNE f b (DeserializeN_ _ _ x) = f b x 
+foldlNE f b (DeserializeN_ _ _ x) = f b x
 foldlNE f b (AccN_         _ _ x _) =  f b x
 foldlNE _ b (SrcN_         _ _) = b
 foldlNE f b (ListN_        _ _ xs) = foldl f b xs
@@ -573,7 +569,7 @@ makeMonoidFoldDefault mempty' mappend' =
   monoidNativeExpr' (AccN_ o v (req, e) k) = return (req, AccN o v e k)
   monoidNativeExpr' (SrcN_ t src) = return (mempty', SrcN t src)
   monoidNativeExpr' (ListN_ v t xs) = return (foldl mappend' mempty' (map fst xs), ListN v t (map snd xs))
-  monoidNativeExpr' (TupleN_ v xs) = return (foldl mappend' mempty' (map fst xs), TupleN v $ map snd xs) 
+  monoidNativeExpr' (TupleN_ v xs) = return (foldl mappend' mempty' (map fst xs), TupleN v $ map snd xs)
   monoidNativeExpr' (RecordN_ o v ps rs)
     = return (foldl mappend' mempty' $ map (fst . snd) rs
              , RecordN o v ps (map (second snd) rs) )
@@ -695,7 +691,7 @@ data SerialExpr_ sm se ne sr nr
 data NativeExpr_ nm se ne sr nr
   = AppSrcN_      TypeF Source [nr]
   | ManN_         nm
-  | ReturnN_      ne 
+  | ReturnN_      ne
   | SerialLetN_   Int se ne
   | NativeLetN_   Int ne ne
   | LetVarN_      TypeF Int
@@ -779,20 +775,20 @@ surroundFoldSerialArgM :: Monad m => SurroundManifoldM m sm nm se ne sr nr -> Fo
 surroundFoldSerialArgM sfm fm = surroundSerialArgM sfm f
   where
   f full@(SerialArgManifold sm) = do
-    sm' <- surroundFoldSerialManifoldM sfm fm sm 
+    sm' <- surroundFoldSerialManifoldM sfm fm sm
     opFoldWithSerialArgM fm full $ SerialArgManifold_ sm'
   f full@(SerialArgExpr se) = do
-    se' <- surroundFoldSerialExprM sfm fm se 
+    se' <- surroundFoldSerialExprM sfm fm se
     opFoldWithSerialArgM fm full $ SerialArgExpr_ se'
 
 surroundFoldNativeArgM :: Monad m => SurroundManifoldM m sm nm se ne sr nr -> FoldWithManifoldM m sm nm se ne sr nr -> NativeArg -> m nr
 surroundFoldNativeArgM sfm fm = surroundNativeArgM sfm f
   where
   f full@(NativeArgManifold nm) = do
-      nm' <- surroundFoldNativeManifoldM sfm fm nm 
+      nm' <- surroundFoldNativeManifoldM sfm fm nm
       opFoldWithNativeArgM fm full $ NativeArgManifold_ nm'
   f full@(NativeArgExpr ne) = do
-      ne' <- surroundFoldNativeExprM sfm fm ne 
+      ne' <- surroundFoldNativeExprM sfm fm ne
       opFoldWithNativeArgM fm full $ NativeArgExpr_ ne'
 
 surroundFoldSerialExprM :: Monad m => SurroundManifoldM m sm nm se ne sr nr -> FoldWithManifoldM m sm nm se ne sr nr -> SerialExpr -> m se
@@ -833,7 +829,7 @@ surroundFoldNativeExprM sfm fm = surroundNativeExprM sfm f
       nativeArgs' <- mapM (surroundFoldNativeArgM sfm fm) nativeArgs
       opFoldWithNativeExprM fm full $ AppSrcN_ t src nativeArgs'
   f full@(ManN nativeManifold) = do
-      nativeManifold' <- surroundFoldNativeManifoldM sfm fm nativeManifold 
+      nativeManifold' <- surroundFoldNativeManifoldM sfm fm nativeManifold
       opFoldWithNativeExprM fm full $ ManN_ nativeManifold'
   f full@(ReturnN ne) = do
       ne' <- surroundFoldNativeExprM sfm fm ne
@@ -866,7 +862,7 @@ surroundFoldNativeExprM sfm fm = surroundNativeExprM sfm f
       opFoldWithNativeExprM fm full (RecordN_ o n ps rs')
       where
         onSndM :: Monad m => (b -> m b') -> (a, b) -> m (a, b')
-        onSndM g (a, b) = (,) a <$> g b 
+        onSndM g (a, b) = (,) a <$> g b
   f full@(LogN t x)  = opFoldWithNativeExprM fm full (LogN_ t x)
   f full@(RealN t x) = opFoldWithNativeExprM fm full (RealN_ t x)
   f full@(IntN t x)  = opFoldWithNativeExprM fm full (IntN_ t x)
@@ -934,7 +930,7 @@ instance HasTypeF NativeManifold where
 
 instance HasTypeS SerialExpr where
   typeSof (ManS sm) = typeSof sm
-  typeSof (AppPoolS t _ sargs) = FunctionS (map typeMof sargs) (SerialS t) 
+  typeSof (AppPoolS t _ sargs) = FunctionS (map typeMof sargs) (SerialS t)
   typeSof (ReturnS e) = typeSof e
   typeSof (SerialLetS _ _ e) = typeSof e
   typeSof (NativeLetS _ _ e) = typeSof e
@@ -969,11 +965,11 @@ typeOfManifold form outputType =
         [] -> outputType
         _ -> Function inputTypes outputType
 
-instance HasTypeM SerialArg where 
+instance HasTypeM SerialArg where
   typeMof (SerialArgManifold sm) = typeMof sm
   typeMof (SerialArgExpr e) = typeMof e
 
-instance HasTypeM NativeArg where 
+instance HasTypeM NativeArg where
   typeMof (NativeArgManifold sm) = typeMof sm
   typeMof (NativeArgExpr e) = typeMof e
 
@@ -1034,13 +1030,13 @@ instance MFunctor NativeManifold where
     mgatedMap g f nm@(NativeManifold m l form ne)
       | gateNativeManifold g nm = mapNativeManifold f $ NativeManifold m l form (mgatedMap g f ne)
       | otherwise = mapNativeManifold f nm
-        
+
 
 instance MFunctor SerialManifold where
     mgatedMap g f sm@(SerialManifold m l form se)
       | gateSerialManifold g sm = mapSerialManifold f $ SerialManifold m l form (mgatedMap g f se)
       | otherwise = mapSerialManifold f sm
-        
+
 
 instance MFunctor SerialArg where
   mgatedMap g f sr
@@ -1108,7 +1104,7 @@ instance Pretty TypeM where
     nest 4 (vsep $ ["Function{"] <> map (\x -> pretty x <+> "->") ts <> [pretty t <> "}"] )
 
 instance Pretty TypeS where
-  pretty PassthroughS = "PassthroughS" 
+  pretty PassthroughS = "PassthroughS"
   pretty (SerialS t) = "SeralS{" <> pretty t <> "}"
   pretty (FunctionS ts t) =
     nest 4 (vsep $ ["Function{"] <> map (\x -> pretty x <+> "->") ts <> [pretty t <> "}"] )
@@ -1133,10 +1129,10 @@ instance Pretty MonoExpr where
     pretty (MonoBndVar (A _) i) = parens $ "x" <> pretty i <+> ":" <+> "<unknown>"
     pretty (MonoBndVar (B t) i) = parens $ "x" <> pretty i <+> ":" <+> pretty t
     pretty (MonoBndVar (C t) i) = parens $ "x" <> pretty i <+> ":" <+> pretty t
-    pretty (MonoAcc    t n v e k) = parens (pretty e) <> "@" <> pretty k
+    pretty (MonoAcc    _ _ _ e k) = parens (pretty e) <> "@" <> pretty k
     pretty (MonoList   _ _ es) = list (map pretty es)
     pretty (MonoTuple  v es) = pretty v <+> tupled (map pretty es)
-    pretty (MonoRecord o v fs rs)
+    pretty (MonoRecord o v fs _)
         = block 4 (pretty o <+> pretty v <> encloseSep "<" ">" "," (map pretty fs)) "manifold record stub"
     pretty (MonoLog    _ x) = viaShow x
     pretty (MonoReal   _ x) = viaShow x
diff --git a/library/Morloc/CodeGenerator/Nexus.hs b/library/Morloc/CodeGenerator/Nexus.hs
index 83035d86..85fbe6ca 100644
--- a/library/Morloc/CodeGenerator/Nexus.hs
+++ b/library/Morloc/CodeGenerator/Nexus.hs
@@ -16,7 +16,6 @@ import qualified Control.Monad.State as CMS
 import Morloc.Data.Doc
 import Morloc.CodeGenerator.Namespace
 import Morloc.Quasi
-import Morloc.Pretty ()
 import qualified Morloc.Data.Text as MT
 import qualified Control.Monad as CM
 import qualified Morloc.Config as MC
@@ -35,7 +34,7 @@ generate cs xs = do
 
   callNames <- mapM (MM.metaName . (\(_, i, _) -> i)) xs |>> catMaybes |>> map pretty
   let gastNames = map (pretty . commandName) cs
-      names = callNames <> gastNames 
+      names = callNames <> gastNames
   fdata <- CM.mapM getFData xs -- [FData]
   outfile <- CMS.gets (fromMaybe "nexus.py" . stateOutfile)
   return $
@@ -110,9 +109,11 @@ if __name__ == '__main__':
         dispatch(cmd, args)
 |]
 
+mapT :: [Doc ann] -> Doc ann
 mapT names = [idoc|command_table = #{dict}|] where
     dict = encloseSep "{" "}" "," (map mapEntryT names)
 
+mapEntryT :: Doc ann -> Doc ann
 mapEntryT n = [idoc|"#{n}" : call_#{n}|]
 
 usageT :: [FData] -> [NexusCommand] -> MDoc
@@ -132,7 +133,7 @@ usageLineT (_, name', t) = vsep
 usageLineConst :: NexusCommand -> MDoc
 usageLineConst cmd = vsep
   ( [idoc|print("  #{pretty (commandName cmd)}")|]
-  : writeTypes (commandType cmd) 
+  : writeTypes (commandType cmd)
   )
 
 writeTypes :: Type -> [MDoc]
@@ -165,7 +166,7 @@ def call_#{subcommand}(args):
 functionCT :: NexusCommand -> MDoc
 functionCT (NexusCommand cmd _ json_str args subs) =
   [idoc|
-def call_#{pretty cmd}(args): 
+def call_#{pretty cmd}(args):
     if len(args) != #{pretty $ length args}:
         sys.exit("Expected #{pretty $ length args} arguments to '#{pretty cmd}', given " + str(len(args)))
     else:
diff --git a/library/Morloc/CodeGenerator/Serial.hs b/library/Morloc/CodeGenerator/Serial.hs
index e47c9f59..ebec9644 100644
--- a/library/Morloc/CodeGenerator/Serial.hs
+++ b/library/Morloc/CodeGenerator/Serial.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 {-|
 Module      : Morloc.CodeGenerator.Serial
@@ -10,7 +10,7 @@ Stability   : experimental
 -}
 
 module Morloc.CodeGenerator.Serial
-  ( makeSerialAST 
+  ( makeSerialAST
   , chooseSerializationCycle
   , isSerializable
   , prettySerialOne
@@ -141,7 +141,7 @@ makeSerialAST m lang t0 = do
             , typePackerForward  = forwardSource
             , typePackerReverse  = reverseSource
             }
-        makeTypePacker (nparam, _, _, _, _) = serializerError $ "Unexpected parameters for atomic variable:" <+> pretty nparam 
+        makeTypePacker (nparam, _, _, _, _) = serializerError $ "Unexpected parameters for atomic variable:" <+> pretty nparam
 
         -- Select the first packer we happen across. This is a very key step and
         -- eventually this function should be replaced with one more carefully
@@ -268,7 +268,7 @@ resolvePacker lang m0 resolvedType@(AppF _ _) (_, unpackedGeneralType, packedGen
                         return . Just $ apply g (existential gc)
 
         return $ case maybeUnpackedGeneralType of
-          (Just unpackedGeneralType) -> Just $ weaveTypeF unpackedGeneralType unpackedConcreteType
+          (Just resolvedUnpackedGeneralType) -> Just $ weaveTypeF resolvedUnpackedGeneralType unpackedConcreteType
           Nothing -> Nothing
 
     unweaveTypeF :: TypeF -> (TypeU, TypeU)
@@ -287,7 +287,7 @@ resolvePacker lang m0 resolvedType@(AppF _ _) (_, unpackedGeneralType, packedGen
             keys = map fst rs
             (vsg, vsc) = unzip $ map (unweaveTypeF . snd) rs
         in (NamU n gv psg (zip keys vsg), NamU n (cv2tv cv) psc (zip keys vsc))
- 
+
     weaveTypeF :: TypeU -> TypeU -> TypeF
     weaveTypeF (VarU gv) (VarU cv) = VarF (FV gv (tv2cv cv))
     weaveTypeF (FunU tsg tg) (FunU tsc tc) = FunF (zipWith weaveTypeF tsg tsc) (weaveTypeF tg tc)
@@ -328,8 +328,8 @@ chooseSerializationCycle (x:_) = Just x
 isSerializable :: SerialAST -> Bool
 isSerializable (SerialPack _ _) = False
 isSerializable (SerialList _ x) = isSerializable x
-isSerializable (SerialTuple _ xs) = all isSerializable xs 
-isSerializable (SerialObject _ _ _ rs) = all (isSerializable . snd) rs 
+isSerializable (SerialTuple _ xs) = all isSerializable xs
+isSerializable (SerialObject _ _ _ rs) = all (isSerializable . snd) rs
 isSerializable (SerialReal   _) = True
 isSerializable (SerialInt    _) = True
 isSerializable (SerialBool   _) = True
diff --git a/library/Morloc/Config.hs b/library/Morloc/Config.hs
index 819d08f1..0acc54c5 100644
--- a/library/Morloc/Config.hs
+++ b/library/Morloc/Config.hs
@@ -17,7 +17,6 @@ module Morloc.Config
   , getDefaultMorlocLibrary
   ) where
 
-import Data.Aeson (FromJSON(..), (.!=), (.:?), withObject)
 import Morloc.Data.Doc
 import Morloc.Namespace
 import qualified Morloc.Language as ML
@@ -25,25 +24,11 @@ import qualified Data.HashMap.Strict as H
 import qualified Data.Yaml.Config as YC
 import qualified Morloc.Data.Text as MT
 import qualified Morloc.System as MS
-import Morloc.Pretty ()
 
 
 getDefaultConfigFilepath :: IO Path
 getDefaultConfigFilepath = MS.combine <$> MS.getHomeDirectory <*> pure ".morloc/config"
 
--- FIXME: remove this chronic multiplication
-instance FromJSON Config where
-  parseJSON =
-    withObject "object" $ \o ->
-      Config
-        <$> o .:? "home" .!= "$HOME/.morloc"
-        <*> o .:? "source" .!= "$HOME/.morloc/src/morloc"
-        <*> o .:? "plain" .!= "morloclib"
-        <*> o .:? "tmpdir" .!= "$HOME/.morloc/tmp" 
-        <*> o .:? "lang_python3" .!= "python3"
-        <*> o .:? "lang_R" .!= "Rscript"
-        <*> o .:? "lang_perl" .!= "perl"
-
 -- | Load the default Morloc configuration, ignoring any local configurations.
 loadDefaultMorlocConfig :: IO Config
 loadDefaultMorlocConfig = do
@@ -64,7 +49,7 @@ loadMorlocConfig :: Maybe Path -> IO Config
 loadMorlocConfig Nothing = do
   defaults <- defaultFields
   MS.loadYamlConfig
-    Nothing 
+    Nothing
     (YC.useCustomEnv defaults)
     loadDefaultMorlocConfig
 loadMorlocConfig (Just configFile) = do
@@ -77,7 +62,7 @@ loadMorlocConfig (Just configFile) = do
         (YC.useCustomEnv defaults)
         loadDefaultMorlocConfig
     else
-      loadMorlocConfig Nothing 
+      loadMorlocConfig Nothing
 
 -- | Create the base call to a pool (without arguments)
 -- For example:
@@ -118,7 +103,7 @@ getDefaultMorlocHome = MS.combine <$> MS.getHomeDirectory <*> pure ".morloc"
 getDefaultMorlocSource :: IO Path
 getDefaultMorlocSource = MS.combine <$> MS.getHomeDirectory <*> pure ".morloc/src/morloc"
 
--- | Get the path to the morloc shared libraries folder 
+-- | Get the path to the morloc shared libraries folder
 getDefaultMorlocLibrary :: IO Path
 getDefaultMorlocLibrary = MS.combine <$> MS.getHomeDirectory <*> pure ".morloc/lib"
 
diff --git a/library/Morloc/Data/Annotated.hs b/library/Morloc/Data/Annotated.hs
index 3c722318..c7a2896f 100644
--- a/library/Morloc/Data/Annotated.hs
+++ b/library/Morloc/Data/Annotated.hs
@@ -28,7 +28,7 @@ class Annotated f where
   annappM :: (Monad m ) => (a -> b -> m c) -> f a b -> m c
   annappM f x = f (ann x) (val x)
 
-  revalM :: Monad m => (a -> b -> m b') -> f a b -> m (f a b') 
+  revalM :: Monad m => (a -> b -> m b') -> f a b -> m (f a b')
   revalM f x = annotate (ann x) <$> f (ann x) (val x)
 
   reannM :: Monad m => (a -> b -> m a') -> f a b -> m (f a' b)
diff --git a/library/Morloc/Data/Bifoldable.hs b/library/Morloc/Data/Bifoldable.hs
index 04f8ab96..0b6e1ec4 100644
--- a/library/Morloc/Data/Bifoldable.hs
+++ b/library/Morloc/Data/Bifoldable.hs
@@ -22,10 +22,10 @@ return2 f x y = return $ f x y
 class (Bifunctor f) => Bifoldable f where
   bilistM :: Monad m => (a -> m c) -> (b -> m c) -> f a b -> m [c]
 
-  bilistsndM :: Monad m => (b -> m c) -> f a b -> m [c] 
+  bilistsndM :: Monad m => (b -> m c) -> f a b -> m [c]
   bilistsndM f = fmap catMaybes . bilistM (return . const Nothing) (fmap Just . f)
 
-  bilistfstM :: Monad m => (a -> m c) -> f a b -> m [c] 
+  bilistfstM :: Monad m => (a -> m c) -> f a b -> m [c]
   bilistfstM f = fmap catMaybes . bilistM (fmap Just . f) (return . const Nothing)
 
   biappendM :: (Monad m, Monoid c) => (a -> m c) -> (b -> m c) -> f a b -> m c
@@ -76,17 +76,17 @@ class (Bifunctor f) => Bifoldable f where
   ubifoldl1M :: (Monoid c, Foldable t, a ~ b, Monad m) => (c -> a -> m c) -> t (f a b) -> m c
   ubifoldl1M f = bifoldl1M f f
 
-  bilist :: (a -> c) -> (b -> c) -> f a b -> [c] 
+  bilist :: (a -> c) -> (b -> c) -> f a b -> [c]
   bilist f g = runIdentity . bilistM (return . f) (return . g)
 
-  bilistsnd :: (b -> c) -> f a b -> [c] 
+  bilistsnd :: (b -> c) -> f a b -> [c]
   bilistsnd f = runIdentity . bilistsndM (return . f)
 
-  bilistfst :: (a -> c) -> f a b -> [c] 
+  bilistfst :: (a -> c) -> f a b -> [c]
   bilistfst f = runIdentity . bilistfstM (return . f)
 
   biappend :: (Monoid c) => (a -> c) -> (b -> c) -> f a b -> c
-  biappend f g = runIdentity . biappendM (return . f) (return . g) 
+  biappend f g = runIdentity . biappendM (return . f) (return . g)
 
   bicat :: (Foldable t) => (a -> c) -> (b -> c) -> t (f a b) -> [c]
   bicat f g = runIdentity . bicatM (return . f) (return . g)
diff --git a/library/Morloc/Data/Bifunctor.hs b/library/Morloc/Data/Bifunctor.hs
index 42938e78..73076fab 100644
--- a/library/Morloc/Data/Bifunctor.hs
+++ b/library/Morloc/Data/Bifunctor.hs
@@ -26,10 +26,10 @@ class Bifunctor f where
   bimap f g = runIdentity . bimapM (return . f) (return . g)
 
   first :: (a -> a') -> f a b -> f a' b
-  first f = runIdentity . firstM (return . f) 
+  first f = runIdentity . firstM (return . f)
 
   second :: (b -> b') -> f a b -> f a b'
-  second f = runIdentity . secondM (return . f) 
+  second f = runIdentity . secondM (return . f)
 
 
 instance Bifunctor Either where
diff --git a/library/Morloc/Data/DAG.hs b/library/Morloc/Data/DAG.hs
index 55425744..40a19762 100644
--- a/library/Morloc/Data/DAG.hs
+++ b/library/Morloc/Data/DAG.hs
@@ -31,6 +31,7 @@ module Morloc.Data.DAG
   , mapEdge
   , filterEdge
   , mapEdgeWithNode
+  , mapEdgeWithNodeM
   , mapEdgeWithNodeAndKey
   , mapNodeWithEdge
   , mapEdgeWithNodeAndKeyM
@@ -41,15 +42,15 @@ module Morloc.Data.DAG
 
 import Morloc.Namespace
 import qualified Morloc.Monad as MM
-import qualified Data.Map as Map 
-import qualified Data.Set as Set 
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 edgelist :: DAG k e n -> [(k,k)]
 edgelist d = concat [[(k,j) | (j,_) <- xs] | (k, (_, xs)) <- Map.toList d ]
 
 insertEdge :: Ord k => k -> k -> e -> DAG k e n -> DAG k e n
 insertEdge k1 k2 e = Map.alter f k1
-  where  
+  where
     -- f :: Maybe [(k, e)] -> Maybe [(k, e)]
     f Nothing = error "Cannot add edge to non-existant node"
     f (Just (n,xs)) = Just (n,(k2,e):xs)
@@ -108,7 +109,7 @@ leafs d = [k | (k, (_, [])) <- Map.toList d]
 -- | Searches a DAG for a cycle, stops on the first observed cycle and returns
 -- the path.
 findCycle :: Ord k => DAG k e n -> Maybe [k]
-findCycle d = case mapMaybe (findCycle' []) (roots d) of 
+findCycle d = case mapMaybe (findCycle' []) (roots d) of
   [] -> Nothing
   (x:_) -> Just x
   where
@@ -154,7 +155,7 @@ shake rootKey d =
     let children = rootChildren rootKey
     in Map.filterWithKey (\k _ -> Set.member k children) d
     where
-        rootChildren localRootKey = case Map.lookup localRootKey d of 
+        rootChildren localRootKey = case Map.lookup localRootKey d of
             Nothing -> Set.singleton localRootKey
             (Just (_, map fst -> children)) -> Set.insert localRootKey $ Set.unions (map rootChildren children)
 
@@ -198,7 +199,7 @@ mapEdgeWithNodeM
   -> DAG k e1 n -> MorlocMonad (DAG k e2 n)
 mapEdgeWithNodeM f d = mapM runit (Map.toList d) |>> Map.fromList
   where
-    runit (k, _) = case local k d of 
+    runit (k, _) = case local k d of
       (Just (n1, xs)) -> do
         e2s <- mapM (\(_, e, n2) -> f n1 e n2) xs
         return (k, (n1, zip (map (\(x,_,_)->x) xs) e2s))
@@ -211,7 +212,7 @@ mapEdgeWithNodeAndKeyM
   -> DAG k e1 n -> MorlocMonad (DAG k e2 n)
 mapEdgeWithNodeAndKeyM f d = mapM runit (Map.toList d) |>> Map.fromList
   where
-    runit (k, _) = case local k d of 
+    runit (k, _) = case local k d of
       (Just (n1, xs)) -> do
         e2s <- mapM (\(_, e, n2) -> f k n1 e n2) xs
         return (k, (n1, zip (map (\(x,_,_)->x) xs) e2s))
@@ -230,7 +231,7 @@ synthesizeDAG f d0 = synthesizeDAG' (Just Map.empty) where
   synthesizeDAG' Nothing = return Nothing
   synthesizeDAG' (Just dn)
     -- stop, we have completed the mapping. Jubilation.
-    | Map.size d0 == Map.size dn = return (Just dn) 
+    | Map.size d0 == Map.size dn = return (Just dn)
     | otherwise = do
         -- traverse the original making any nodes that now have met dependencies
         dn' <- foldlM addIfPossible dn (Map.toList d0)
@@ -272,7 +273,7 @@ inherit k f d = case local k d of
     -- if k has no children, return empty list
     Nothing -> []
     -- else if k has children
-    -- then 
+    -- then
     (Just (_, xs)) -> concat [[(v, lookupAliasedTerm v k' f d) | (v,_) <- vs] | (k', vs, _) <- xs]
 
 lookupAliasedTerm
diff --git a/library/Morloc/Data/Map/Extra.hs b/library/Morloc/Data/Map/Extra.hs
index d07e9918..b87f2bc5 100644
--- a/library/Morloc/Data/Map/Extra.hs
+++ b/library/Morloc/Data/Map/Extra.hs
@@ -19,10 +19,11 @@ module Morloc.Data.Map.Extra (
 ) where
 
 import Prelude hiding (mapM)
-import qualified Prelude 
+import qualified Prelude
 import qualified Data.Map as Map
 import Control.Monad (foldM)
 import Data.List.Extra (groupSort)
+import Data.Bifunctor (first)
 
 -- A local utility function
 onSndM :: Monad m => (b -> m c) -> (a, b) -> m (a, c)
@@ -56,7 +57,7 @@ mapKeysWithM
 mapKeysWithM f g m
   = Map.fromList
   <$> Prelude.mapM foldValues
-      (groupSort $ map (\(k,x) -> (g k, x)) (Map.toList m))
+      (groupSort $ map (first g) (Map.toList m))
   where
     foldValues (k, v:vs) = (,) k <$> foldM f v vs
     foldValues _ = undefined -- there will never be empty values
diff --git a/library/Morloc/Data/Rose.hs b/library/Morloc/Data/Rose.hs
index c8da1ec5..fe839610 100644
--- a/library/Morloc/Data/Rose.hs
+++ b/library/Morloc/Data/Rose.hs
@@ -31,7 +31,7 @@ search f = filter f . flatten
 -- | Make list of values
 flatten :: Rose a -> [a]
 flatten Nil = []
-flatten (Rose x xs) = x : concatMap flatten xs 
+flatten (Rose x xs) = x : concatMap flatten xs
 
 
 -- | Remove branches where the value of the predicate returns true
@@ -48,7 +48,7 @@ mapScope
   => (b -> a -> b) -- fold an element into scope context
   -> (a -> b -> c) -- update a value given scope context
   -> b  -- ^ initial element
-  -> Rose a -- ^ input tree 
+  -> Rose a -- ^ input tree
   -> Rose c
 mapScope _ _ _ Nil = Nil
 mapScope f g b (Rose x kids) =
diff --git a/library/Morloc/Data/Text.hs b/library/Morloc/Data/Text.hs
index 1411c4f6..07b658b8 100644
--- a/library/Morloc/Data/Text.hs
+++ b/library/Morloc/Data/Text.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-} 
+{-# LANGUAGE OverloadedStrings #-}
 
 {-|
 Module      : Morloc.Data.Text
@@ -35,6 +35,7 @@ import qualified Data.Text.Lazy as DL
 import Prelude hiding (concat, length, lines, unlines)
 import qualified Safe
 import qualified Text.Pretty.Simple as Pretty
+import Data.Maybe (fromMaybe)
 
 show' :: Show a => a -> Text
 show' = pack . show
@@ -57,9 +58,7 @@ pretty = DL.toStrict . Pretty.pShowNoColor
 -- | Parse a TSV, ignore first line (header). Cells are also unquoted and
 -- wrapping angles are removed.
 parseTSV :: Text -> [[Maybe Text]]
-parseTSV =
-  map (map (nonZero . undquote . unangle)) .
-  map (split ((==) '\t')) . Prelude.tail . lines
+parseTSV = map (map (nonZero . undquote . unangle) . split ('\t' ==)) . Prelude.tail . lines
 
 liftToText :: (String -> String) -> Text -> Text
 liftToText f = pack . f . unpack
@@ -71,7 +70,7 @@ unparseTSV = unlines . map renderRow
     renderRow :: [Maybe Text] -> Text
     renderRow = intercalate "\t" . map renderCell
     renderCell :: Maybe Text -> Text
-    renderCell (Nothing) = "-"
+    renderCell Nothing = "-"
     renderCell (Just x) = x
 
 nonZero :: Text -> Maybe Text
@@ -81,7 +80,7 @@ nonZero s =
     else Just s
 
 unenclose :: Text -> Text -> Text -> Text
-unenclose a b x = maybe x id (stripPrefix a x >>= stripSuffix b)
+unenclose a b x = fromMaybe x (stripPrefix a x >>= stripSuffix b)
 
 unangle :: Text -> Text
 unangle = unenclose "<" ">"
diff --git a/library/Morloc/Error.hs b/library/Morloc/Error.hs
deleted file mode 100644
index c126e97f..00000000
--- a/library/Morloc/Error.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-{-|
-Module      : Morloc.Error
-Description : Prepare error messages from MorlocError types
-Copyright   : (c) Zebulun Arendsee, 2021
-License     : GPL-3
-Maintainer  : zbwrnz@gmail.com
-Stability   : experimental
-
-MorlocError is the type used within morloc to store data related to any errors
-that are encountered. Data constructors in the MorlocError type may associates
-data with the error. This data may be an arbitrary message or any other type.
-The @errmsg@ function in this module defines how these errors will be printed
-to the user.
--}
-module Morloc.Error () where
-
-import Morloc.Namespace
-import Morloc.Data.Doc
-import Morloc.Pretty ()
-import qualified Morloc.Data.Text as MT
-import Text.Megaparsec.Error (errorBundlePretty)
-
-instance Show MorlocError where
-  show = MT.unpack . render . pretty
-
-instance Show TypeError where
-  show = MT.unpack . render . pretty
-
-instance Pretty MorlocError where
-  pretty (IndexedError i e) = "At index" <+> pretty i <> ":" <+> pretty e
-  pretty (NotImplemented msg) = "Not yet implemented: " <> pretty msg
-  pretty (NotSupported msg) = "NotSupported: " <> pretty msg
-  pretty (UnknownLanguage lang) =
-    "'" <> pretty lang <> "' is not recognized as a supported language"
-  pretty (SyntaxError err') = "SyntaxError: " <> pretty (errorBundlePretty err')
-  pretty (SerializationError t) = "SerializationError: " <> pretty t
-  pretty (CannotLoadModule t) = "CannotLoadModule: " <> pretty t
-  pretty (SystemCallError cmd loc msg) =
-    "System call failed at (" <>
-    pretty loc <> "):\n" <> " cmd> " <> pretty cmd <> "\n" <> " msg>\n" <> pretty msg
-  pretty (PoolBuildError msg) = "PoolBuildError: " <> pretty msg
-  pretty (SelfRecursiveTypeAlias v) = "SelfRecursiveTypeAlias: " <> pretty v
-  pretty (MutuallyRecursiveTypeAlias vs) = "MutuallyRecursiveTypeAlias: " <> tupled (map pretty vs)
-  pretty (BadTypeAliasParameters v exp' obs)
-    =  "BadTypeAliasParameters: for type alias " <> pretty v
-    <> " expected " <> pretty exp'
-    <> " parameters but found " <> pretty obs
-  pretty (ConflictingTypeAliases t1 t2)
-    = "ConflictingTypeAliases:"
-    <> "\n  t1:" <+> pretty t1
-    <> "\n  t2:" <+> pretty t2
-  pretty (CallTheMonkeys msg) =
-    "There is a bug in the code, send this message to the maintainer: " <> pretty msg
-  pretty (GeneratorError msg) = "GeneratorError: " <> pretty msg
-  pretty (ConcreteTypeError err') = "Concrete type error: " <> pretty err'
-  pretty (GeneralTypeError err') = "General type error: " <> pretty err'
-  pretty ToplevelRedefinition = "ToplevelRedefinition"
-  pretty (OtherError msg) = "OtherError: " <> pretty msg
-  -- TODO: this will be a common class of errors and needs an informative message
-  pretty (IncompatibleGeneralType a b)
-    = "Incompatible general types:" <+> parens (pretty a) <+> "vs" <+> parens (pretty b)
-  -- container errors
-  pretty EmptyTuple = "EmptyTuple"
-  pretty TupleSingleton = "TupleSingleton"
-  pretty EmptyRecord = "EmptyRecord"
-  -- module errors
-  pretty (MultipleModuleDeclarations mv) = "MultipleModuleDeclarations: " <> tupled (map pretty mv) 
-  pretty (NestedModule name') = "Nested modules are currently illegal: " <> pretty name'
-  pretty (NonSingularRoot ms) = "Expected exactly one root module, found" <+> list (map pretty ms) 
-  pretty (ImportExportError (MV m) msg) = "Error in module '" <> pretty m <> "': "  <> pretty msg
-  pretty (CannotFindModule name') = "Cannot find morloc module '" <> pretty name' <> "'"
-  pretty CyclicDependency = "CyclicDependency"
-  pretty (SelfImport _) = "SelfImport"
-  pretty BadRealization = "BadRealization"
-  pretty MissingSource = "MissingSource"
-  -- serialization errors
-  pretty (CyclicPacker t1 t2)
-    = "Error CyclicPacker - a term is described as both a packer and an unpacker:\n  "
-    <> pretty t1 <> "\n  " <> pretty t2
-  -- type extension errors
-  pretty (ConflictingPackers t1 t2)
-    = "Error ConflictingPackers:"
-    <> "\n  t1:" <+> pretty t1
-    <> "\n  t2:" <+> pretty t2
-  pretty (UndefinedType v)
-    =  "UndefinedType: could not resolve type" <+> squotes (pretty v)
-    <> ". You may be missing a language-specific type definition."
-  pretty (AmbiguousPacker _) = "AmbiguousPacker"
-  pretty (AmbiguousUnpacker _) = "AmbiguousUnpacker"
-  pretty (AmbiguousCast _ _) = "AmbiguousCast"
-  pretty (IllegalPacker t) = "IllegalPacker:" <+> pretty t
-  pretty (IncompatibleRealization _) = "IncompatibleRealization"
-  pretty MissingAbstractType = "MissingAbstractType"
-  pretty ExpectedAbstractType = "ExpectedAbstractType"
-  pretty CannotInferConcretePrimitiveType = "CannotInferConcretePrimitiveType"
-  pretty ToplevelStatementsHaveNoLanguage = "ToplevelStatementsHaveNoLanguage"
-  pretty InconsistentWithinTypeLanguage = "InconsistentWithinTypeLanguage"
-  pretty CannotInferLanguageOfEmptyRecord = "CannotInferLanguageOfEmptyRecord"
-  pretty ConflictingSignatures = "ConflictingSignatures: currently a given term can have only one type per language"
-  pretty CompositionsMustBeGeneral = "CompositionsMustBeGeneral"
-  pretty IllegalConcreteAnnotation = "IllegalConcreteAnnotation"
-  pretty (DagMissingKey msg) = "DagMissingKey: " <> pretty msg
-  pretty TooManyRealizations = "TooManyRealizations"
-  pretty (CannotSynthesizeConcreteType m src t [])
-    = "Cannot synthesize" <+> pretty (srcLang src) <+>
-      "type for" <+> squotes (pretty (srcAlias src)) <+>
-      "in module" <+> pretty m <+>
-      "from general type:" <+> parens (pretty t)
-  pretty (CannotSynthesizeConcreteType m src t vs)
-    = pretty (CannotSynthesizeConcreteType m src t []) <> "\n" <>
-      "  Cannot resolve concrete types for these general types:" <+> list (map pretty vs) <> "\n" <>
-      "  Are you missing type alias imports?"
-
-
-instance Pretty TypeError where
-  pretty (SubtypeError t1 t2 msg)
-    = "SubtypeError:" <+> pretty msg <> "\n  "
-    <> "(" <> pretty t1 <+> "<:" <+> pretty t2 <> ")"
-  pretty (InstantiationError t1 t2 msg)
-    = "InstantiationError:" <+> "(" <> pretty t1 <+> "<:=" <+> pretty t2 <> ")" <> "\n"
-    <> "   " <> align (pretty msg)
-  pretty (EmptyCut gi) = "EmptyCut:" <+> pretty gi
-  pretty OccursCheckFail {} = "OccursCheckFail"
-  pretty (Mismatch t1 t2 msg)
-    = "Mismatch"
-    <+> tupled ["t1=" <> pretty t1, "t2=" <> pretty t2]
-    <+> pretty msg
-  pretty (UnboundVariable v) = "UnboundVariable:" <+> pretty v
-  pretty (KeyError k t) = "KeyError:" <+> dquotes (pretty k) <+> "not found in record:" <+> pretty t
-  pretty (MissingConcreteSignature e lang) = "No concrete signature found for" <+> pretty lang <+> "function named" <+> squotes (pretty e) 
-  pretty (MissingGeneralSignature e) = "MissingGeneralSignature for" <+> squotes (pretty e)
-  pretty ApplicationOfNonFunction = "ApplicationOfNonFunction"
-  pretty TooManyArguments = "TooManyArguments"
-  pretty (MissingFeature msg) = "MissingFeature: " <> pretty msg
-  pretty (EmptyExpression e) = "EmptyExpression:" <+> squotes (pretty e) <+> "has no bound signature or expression"
-  pretty InfiniteRecursion = "InfiniteRecursion"
-  pretty (FunctionSerialization v) = "Undefined function" <+> dquotes (pretty v) <> ", did you forget an import?"
diff --git a/library/Morloc/Frontend/AST.hs b/library/Morloc/Frontend/AST.hs
index 21eb28bb..a3434f21 100644
--- a/library/Morloc/Frontend/AST.hs
+++ b/library/Morloc/Frontend/AST.hs
@@ -50,7 +50,7 @@ findTypedefs
   -> (               Map.Map TVar [([TVar], TypeU, Bool)]
      , Map.Map Lang (Map.Map TVar [([TVar], TypeU, Bool)])
      )
-findTypedefs (ExprI _ (TypE Nothing v vs t)) = (Map.singleton v [(vs, t, False)], Map.empty) 
+findTypedefs (ExprI _ (TypE Nothing v vs t)) = (Map.singleton v [(vs, t, False)], Map.empty)
 findTypedefs (ExprI _ (TypE (Just (lang, isTerminal)) v vs t)) = (Map.empty, Map.singleton lang (Map.singleton v [(vs, t, isTerminal)]))
 findTypedefs (ExprI _ (ModE _ es)) = foldl combine (Map.empty, Map.empty) (map findTypedefs es) where
   combine (g1, c1) (g2, c2)
diff --git a/library/Morloc/Frontend/Lexer.hs b/library/Morloc/Frontend/Lexer.hs
index 2a7903c8..f9820b83 100644
--- a/library/Morloc/Frontend/Lexer.hs
+++ b/library/Morloc/Frontend/Lexer.hs
@@ -61,7 +61,7 @@ data ParserState = ParserState {
   , stateVarIndex :: Int
   , stateExpIndex :: Int
   , stateGenerics :: [TVar] -- store the observed generic variables in the current type
-                               -- you should reset the field before parsing a new type 
+                               -- you should reset the field before parsing a new type
   , stateMinPos :: Pos
   , stateAccepting :: Bool
 } deriving(Show)
@@ -94,10 +94,10 @@ setMinPos = do
 
 -- | Require elements all start on the same line as the first element. At least
 -- one expression must match.
-align :: Parser a -> Parser [a] 
+align :: Parser a -> Parser [a]
 align p = do
   s <- CMS.get
-  let minPos0 = stateMinPos s 
+  let minPos0 = stateMinPos s
       accept0 = stateAccepting s
   curPos <- L.indentLevel
   xs <- many1 (resetPos curPos True >> p)
@@ -117,14 +117,12 @@ isInset :: Parser ()
 isInset = do
   minPos <- CMS.gets stateMinPos
   curPos <- L.indentLevel
-  if curPos <= minPos
-    then
-      L.incorrectIndent GT minPos curPos
-    else
-      return ()
+  when (curPos <= minPos) (L.incorrectIndent GT minPos curPos)
 
+sc :: Parser ()
 sc = L.space space1 comments empty
 
+symbol :: MT.Text -> Parser MT.Text
 symbol = lexeme . L.symbol sc
 
 lexemeBase :: Parser a -> Parser a
@@ -147,7 +145,7 @@ lexeme p = do
       if minPos < curPos
         then
           lexemeBase p
-        else 
+        else
           L.incorrectIndent LT minPos curPos
 
 
@@ -175,7 +173,7 @@ sepBy2 p s = do
   _ <- s
   xs <- sepBy1 p s
   return (x:xs)
-  
+
 
 comments :: Parser ()
 comments =  L.skipLineComment "--"
@@ -185,11 +183,11 @@ comments =  L.skipLineComment "--"
 data Sign = Pos | Neg
 
 number :: Parser (Either Integer DS.Scientific)
-number = lexeme $ number_
+number = lexeme number_
 
 number_ :: Parser (Either Integer DS.Scientific)
 number_ = do
-  x  <- try (fmap (Right . DS.fromFloatDigits) (L.signed sc L.float)) <|> (fmap Left (L.signed sc L.decimal))
+  x  <- try (fmap (Right . DS.fromFloatDigits) signedFloat) <|> fmap Left signedDecimal
   e <- optional _exp
   return $ case (x, e) of
     (Left i,  Nothing) -> Left i
@@ -215,11 +213,17 @@ number_ = do
       (Just '-') -> return Neg
       _ -> return Pos
 
+  signedFloat :: Parser Double
+  signedFloat = L.signed sc L.float
+
+  signedDecimal :: Parser Integer
+  signedDecimal = L.signed sc L.decimal
+
 surround :: Parser l -> Parser r -> Parser a -> Parser a
 surround l r v = do
-  l
+  _ <- l
   v' <- v
-  r
+  _ <- r
   return v'
 
 brackets :: Parser a -> Parser a
@@ -271,7 +275,7 @@ mkFreename firstLetter = (lexeme . try) (p >>= check)
   where
     p = fmap MT.pack $ (:) <$> firstLetter <*> many (alphaNumChar <|> char '\'')
     check x =
-      if elem x reservedWords
+      if x `elem` reservedWords
         then failure Nothing Set.empty -- TODO: error message
         else return x
 
diff --git a/library/Morloc/Frontend/Namespace.hs b/library/Morloc/Frontend/Namespace.hs
index d80c2083..463e4d88 100644
--- a/library/Morloc/Frontend/Namespace.hs
+++ b/library/Morloc/Frontend/Namespace.hs
@@ -46,7 +46,7 @@ mapExprM :: Monad m => (Expr -> m Expr) -> ExprI -> m ExprI
 mapExprM f = g where
   g (ExprI i (ModE v xs)) = ExprI i <$> (mapM g xs >>= f . ModE v)
   g (ExprI i (AssE v e es)) = ExprI i <$> ((AssE v <$> g e <*> mapM g es) >>= f)
-  g (ExprI i (AccE k e)) = ExprI i <$> ((AccE k <$> g e) >>= f)
+  g (ExprI i (AccE k e)) = ExprI i <$> (g e >>= f . AccE k)
   g (ExprI i (LstE es)) = ExprI i <$> (mapM g es >>= f . LstE)
   g (ExprI i (TupE es)) = ExprI i <$> (mapM g es >>= f . TupE)
   g (ExprI i (AppE e es)) = ExprI i <$> ((AppE <$> g e <*> mapM g es) >>= f)
@@ -61,7 +61,7 @@ mapExprM f = g where
 -- WARNING: silent bad things happen if this function does not copy all indices
 copyState :: Int -> Int -> MorlocMonad ()
 copyState oldIndex newIndex = do
-  s <- MM.get 
+  s <- MM.get
   MM.put $ s
     { stateSignatures = updateGMap (stateSignatures s)
     , stateConcreteTypedefs = updateGMap (stateConcreteTypedefs s)
@@ -77,8 +77,8 @@ copyState oldIndex newIndex = do
       (Just g') -> g'
       Nothing -> g
 
-    updateMap m = case Map.lookup oldIndex m of 
+    updateMap m = case Map.lookup oldIndex m of
       (Just x) -> Map.insert newIndex x m
       Nothing -> m
 
-    updateList xs = if oldIndex `elem` xs then newIndex : xs else xs 
+    updateList xs = if oldIndex `elem` xs then newIndex : xs else xs
diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index f7c61680..ce03a580 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -30,7 +30,7 @@ import qualified Morloc.System as MS
 -- module is written written into the DAG of previously observed modules.
 readProgram
   :: Maybe MVar
-  -- ^ The expected module name, 
+  -- ^ The expected module name,
   -> Maybe Path
   -- ^ An optional path to the file the source code was read from. If no path
   -- is given, then the source code was provided as a string.
@@ -41,11 +41,11 @@ readProgram
 readProgram moduleName modulePath sourceCode pstate p =
   case runParser
          (CMS.runStateT (sc >> pProgram moduleName <* eof) (reenter modulePath pstate))
-         (maybe "<expr>" id modulePath)
+         (fromMaybe "<expr>" modulePath)
          sourceCode of
     (Left err') -> Left err'
     -- all will be ModE expressions, since pTopLevel can return only these
-    (Right (es, s)) -> 
+    (Right (es, s)) ->
       let dag = foldl (\d (k,xs,n) -> Map.insert k (n,xs) d) p (map AST.findEdges es)
       in Right (dag, s)
 
@@ -73,7 +73,7 @@ pModule
     :: Maybe MVar -- ^ The expected module path
     -> Parser ExprI
 pModule expModuleName = do
-  reserved "module"
+  _ <- reserved "module"
 
   moduleName <- case expModuleName of
     Nothing -> MT.intercalate "." <$> sepBy freename (symbol ".")
@@ -148,7 +148,7 @@ pMain = do
   exprI $ ModE (MV "Main") es
 
 plural :: Functor m => m a -> m [a]
-plural = fmap return 
+plural = fmap return
 
 createMainFunction :: [ExprI] -> Parser [ExprI]
 createMainFunction es = case (init es, last es) of
@@ -167,7 +167,7 @@ createMainFunction es = case (init es, last es) of
 
 -- | Expressions including ones that are allowed only at the top-level of a scope
 pTopExpr :: Parser [ExprI]
-pTopExpr = 
+pTopExpr =
       try (plural pImport)
   <|> try (plural pTypedef)
   <|> try (plural pTypeclass)
@@ -211,14 +211,14 @@ pComposition = do
             let v = EV ("x" <> MT.show' (stateExpIndex s + 1))
 
             v' <- exprI (VarE v)
-            
+
             inner <- case last fs of
                 (ExprI i (AppE x xs)) -> return $ ExprI i (AppE x (xs <> [v']))
                 e -> exprI $ AppE e [v']
-            
+
             composition <- foldM compose inner (reverse (init fs))
 
-            exprI $ LamE [v] composition 
+            exprI $ LamE [v] composition
 
     where
 
@@ -296,7 +296,7 @@ pTypedef = try pTypedefType <|> pTypedefObject where
     return (v, True)
 
   pGeneralType = do
-    t <- pType 
+    t <- pType
     return (t, False)
 
   pGeneralVar = do
@@ -347,21 +347,21 @@ pTypedef = try pTypedefType <|> pTypedefObject where
     f t = return $ BT.listU t
 
   pNamType :: Parser NamType
-  pNamType = choice [pNamObject, pNamTable, pNamRecord] 
+  pNamType = choice [pNamObject, pNamTable, pNamRecord]
 
   pNamObject :: Parser NamType
   pNamObject = do
-    _ <- reserved "object" 
+    _ <- reserved "object"
     return NamObject
 
   pNamTable :: Parser NamType
   pNamTable = do
-    _ <- reserved "table" 
+    _ <- reserved "table"
     return NamTable
 
   pNamRecord :: Parser NamType
   pNamRecord = do
-    _ <- reserved "record" 
+    _ <- reserved "record"
     return NamRecord
 
   pLangNamespace :: Parser Lang
@@ -467,7 +467,7 @@ pSrcE = do
 
 pSource :: Parser [Source]
 pSource = do
-  reserved "source"
+  _ <- reserved "source"
   modulePath <- CMS.gets stateModulePath
   language <- pLang
   srcfile <- optional (reserved "from" >> stringLiteral |>> MT.unpack)
@@ -481,7 +481,7 @@ pSource = do
     (Just _, Nothing) -> return Nothing
     -- this case SHOULD only occur in testing where the source file does not exist
     -- file non-existence will be caught later
-    (Nothing, s) -> return s 
+    (Nothing, s) -> return s
   return [
     Source
       { srcName = srcVar
diff --git a/library/Morloc/Frontend/PartialOrder.hs b/library/Morloc/Frontend/PartialOrder.hs
deleted file mode 100644
index 4adab364..00000000
--- a/library/Morloc/Frontend/PartialOrder.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-|
-Module      : Morloc.Frontend.PartialOrder
-Description : Partial order implementation for types
-Copyright   : (c) Zebulun Arendsee, 2021
-License     : GPL-3
-Maintainer  : zbwrnz@gmail.com
-Stability   : experimental
--}
-
-module Morloc.Frontend.PartialOrder (
-    isSubtypeOf
-  , equivalent
-  , mostGeneral
-  , mostSpecific
-  , mostSpecificSubtypes
-  , (<=)
-) where
-
-import Morloc.Frontend.Namespace
-import Morloc.Data.Text (Text)
-import qualified Data.Set as Set
-import qualified Data.PartialOrd as P
-import qualified Data.List as DL
-
--- Types are partially ordered, 'forall a . a' is lower (more generic) than
--- Int. But 'forall a . a -> a' cannot be compared to 'forall a . a', since
--- they are different kinds.
--- The order of types is used to choose the most specific serialization functions.
--- As far as serialization is concerned, properties and constraints do not matter.
-instance P.PartialOrd TypeU where
-  (<=) (VarU v1) (VarU v2) = v1 == v2
-  (<=) (ExistU v1 ts1 rs1) (ExistU v2 ts2 rs2)
-    =  v1 == v2
-    && length ts1 == length ts2
-    && and (zipWith (P.<=) ts1 ts2)
-    && and [maybe False (t1 P.<=) (lookup k rs2) | (k, t1) <- rs1]
-  (<=) (ForallU v t1) t2
-    | (P.==) (ForallU v t1) t2 = True
-    | otherwise = (P.<=) (substituteFirst v t1 t2) t2
-  (<=) (FunU (t11:rs1) t12) (FunU (t21:rs2) t22) = t11 P.<= t21 && FunU rs1 t12 P.<= FunU rs2 t22
-  (<=) (FunU [] t12) (FunU [] t22) = t12 P.<= t22
-  (<=) (AppU t1 (t11:rs1)) (AppU t2 (t21:rs2)) = t11 P.<= t21 && AppU t1 rs1 P.<= AppU t2 rs2
-  (<=) (AppU t1 []) (AppU t2 []) = t1 P.<= t2
-  -- the records do not need to be in the same order to be equivalent
-  -- ---- do I need to sort on ps1/ps2 as well?
-  (<=) (NamU o1 n1 ps1 ((k1,e1):rs1)) (NamU o2 n2 ps2 es2)
-    = case DL.partition ((== k1) . fst) es2 of
-       ([(_,e2)], rs2) -> e1 P.<= e2 && NamU o1 n1 ps1 rs1 P.<= NamU o2 n2 ps2 rs2
-       _ -> False
-  (<=) (NamU o1 n1 ps1 []) (NamU o2 n2 ps2 [])
-    = o1 == o2 && n1 == n2 && length ps1 == length ps2
-  (<=) _ _ = False
-
-  (==) (ForallU v1 t1) (ForallU v2 t2) =
-    if Set.member (VarU v1) (free t2)
-    then
-      let v = newVariable t1 t2
-      in (P.==) (substituteTVar v1 (VarU v) t1) (substituteTVar v2 (VarU v) t2)
-    else (P.==) t1 (substituteTVar v2 (VarU v1) t2)
-  (==) a b = a == b
-
--- Substitute all v for the first term in t2 that corresponds to v in t1. If v
--- does not occur in t1, then t1 is returned unchanged (e.g., `forall a . Int`).
-substituteFirst :: TVar -> TypeU -> TypeU -> TypeU
-substituteFirst v t1 t2 = case findFirst v t1 t2 of
-  (Just t) -> substituteTVar v t t1
-  Nothing -> t1
-
-findFirst :: TVar -> TypeU -> TypeU -> Maybe TypeU
-findFirst v = f where
-  f (VarU v') t2
-    | v == v' = Just t2
-    | otherwise = Nothing
-  f (ForallU v1 t1) (ForallU v2 t2)
-    | v == v1 = Nothing
-    | otherwise = f t1 (substituteTVar v2 (VarU v1) t2)
-  f (ForallU v1 t1) t2
-    | v == v1 = Nothing
-    | otherwise = f (substituteTVar v1 (VarU v1) t1) t2
-  f (FunU ts1 t1) (FunU ts2 t2)
-    = foldl firstOf Nothing (zipWith f (ts1 <> [t1]) (ts2 <> [t2]))
-  f (AppU t1 ts1) (AppU t2 ts2)
-    = foldl firstOf Nothing (zipWith f (t1:ts1) (t2:ts2))
-  f (NamU o1 n1 ps1 ((k1,e1):rs1)) (NamU o2 n2 ps2 es2)
-    = case DL.partition ((== k1) . fst) es2 of
-       ([(_,e2)], rs2) -> firstOf (f e1 e2) (f (NamU o1 n1 ps1 rs1) (NamU o2 n2 ps2 rs2))
-       _ -> Nothing 
-  f _ _ = Nothing
-
-  firstOf :: Maybe a -> Maybe a -> Maybe a
-  firstOf (Just x) _ = Just x
-  firstOf _ (Just x) = Just x
-  firstOf _ _ = Nothing
-
-
--- | is t1 a generalization of t2?
-isSubtypeOf :: TypeU -> TypeU -> Bool
-isSubtypeOf t1 t2 = case P.compare t1 t2 of
-  (Just x) -> x <= EQ
-  _ -> False
-
-equivalent :: TypeU -> TypeU -> Bool
-equivalent t1 t2 = isSubtypeOf t1 t2 && isSubtypeOf t2 t1
-
--- | find all types that are not greater than any other type
-mostGeneral :: [TypeU] -> [TypeU]
-mostGeneral = P.minima
-
--- | find all types that are not less than any other type
-mostSpecific :: [TypeU] -> [TypeU]
-mostSpecific = P.maxima
-
--- | find the most specific subtypes
-mostSpecificSubtypes :: TypeU -> [TypeU] -> [TypeU]
-mostSpecificSubtypes t ts = mostSpecific $ filter (`isSubtypeOf` t) ts
diff --git a/library/Morloc/Frontend/Restructure.hs b/library/Morloc/Frontend/Restructure.hs
index 0174d4b1..ec67ab7b 100644
--- a/library/Morloc/Frontend/Restructure.hs
+++ b/library/Morloc/Frontend/Restructure.hs
@@ -12,7 +12,6 @@ Stability   : experimental
 module Morloc.Frontend.Restructure (restructure) where
 
 import Morloc.Frontend.Namespace
-import Morloc.Pretty ()
 import Morloc.Data.Doc
 import qualified Morloc.Frontend.AST as AST
 import qualified Morloc.Monad as MM
@@ -22,7 +21,6 @@ import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.TypeEval as TE
 import qualified Data.Set as Set
-import qualified Morloc.Frontend.PartialOrder as MTP
 import Morloc.Typecheck.Internal (qualify, unqualify)
 
 -- | Resolve type aliases, term aliases and import/exports
@@ -58,7 +56,7 @@ doM f x = f x >> return x
 -- is why I need to raise an explicit error to avoid infinite loops.
 checkForSelfRecursion :: Ord k => DAG k e ExprI -> MorlocMonad (DAG k e ExprI)
 checkForSelfRecursion d = do
-  MDD.mapNodeM (AST.checkExprI isExprSelfRecursive) d
+  _ <- MDD.mapNodeM (AST.checkExprI isExprSelfRecursive) d
   return d
   where
     -- A typedef is self-recursive if its name appears in its definition
@@ -83,7 +81,7 @@ checkForSelfRecursion d = do
     hasTerm v (NamU o n (p:ps) []) = hasTerm v p || hasTerm v (NamU o n ps [])
     hasTerm _ (NamU _ _ [] []) = False
 
-    hasTerm _ (ExistU _ _ _) = error "There should not be existentionals in typedefs"
+    hasTerm _ ExistU{} = error "There should not be existentionals in typedefs"
 
 
 -- | Consider export/import information to determine which terms are imported
@@ -208,7 +206,7 @@ collectTypes fullDag = do
 
   completeRecord :: Scope -> TVar -> [([TVar], TypeU, Bool)] -> [([TVar], TypeU, Bool)]
   completeRecord gscope v xs = case Map.lookup v gscope of
-    (Just ys) -> map (completeValue [t | (_, t, _) <- ys]) xs 
+    (Just ys) -> map (completeValue [t | (_, t, _) <- ys]) xs
     Nothing -> xs
 
   completeValue :: [TypeU] -> ([TVar], TypeU, Bool) -> ([TVar], TypeU, Bool)
@@ -302,8 +300,8 @@ collectMogrifiers fullDag = do
     isNovel ((t1, src1):ys) x@(t2, src2)
       | srcPath src1 == srcPath src2 &&
         srcName src1 == srcName src2 &&
-        MTP.isSubtypeOf t1 t2 &&
-        MTP.isSubtypeOf t2 t1 = False
+        isSubtypeOf t1 t2 &&
+        isSubtypeOf t2 t1 = False
       | otherwise = isNovel ys x
 
   formMogrifiers
@@ -349,7 +347,7 @@ collectMogrifiers fullDag = do
         where
           srcMap = Map.fromListWith (<>) [(srcAlias src, [src]) | src <- srcs]
           mogMaybe = concat [[(p, (etype e, Map.lookup v srcMap)) | p <- Set.toList (eprop e)] | (v, _, e) <- es]
-          mogrifiers = Map.fromListWith (<>) [(p, [(t, src) | src <- srcs]) | (p, (t, Just srcs)) <- mogMaybe]
+          mogrifiers = Map.fromListWith (<>) [(p, [(t, src) | src <- srcs']) | (p, (t, Just srcs')) <- mogMaybe]
 
       inherit :: [(TVar, TVar)] -> Map.Map Property [(TypeU, Source)] -> Map.Map Property [(TypeU, Source)]
       inherit aliasMap mogMap
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index bd80f178..71910463 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -13,14 +13,12 @@ module Morloc.Frontend.Treeify (treeify) where
 
 import Morloc.Frontend.Namespace
 import Morloc.Data.Doc
-import Morloc.Pretty ()
 import qualified Control.Monad.State as CMS
 import qualified Morloc.Frontend.AST as AST
 import qualified Morloc.Monad as MM
 import qualified Morloc.Data.DAG as DAG
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.Data.GMap as GMap
-import qualified Morloc.Frontend.PartialOrder as PO
 
 -- | Every term must either be sourced or declared.
 data TermOrigin = Declared ExprI | Sourced Source
@@ -198,13 +196,13 @@ linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
     -- shadow all terms bound under the lambda
     let m' = foldr Map.delete m ks
     -- then link the assignment term and all local "where" statements (es)
-    linkSignatures mv (e:es) (Map.map snd m')
+    _ <- linkSignatures mv (e:es) (Map.map snd m')
     return ()
   -- 4. assignments that have no parameters
   link m (ExprI i (AssE v e es)) = do
-    setMonomorphicType m i v
+    _ <- setMonomorphicType m i v
     -- then link the assignment term and all local "where" statements (es)
-    linkSignatures mv (e:es) (Map.map snd m)
+    _ <- linkSignatures mv (e:es) (Map.map snd m)
     return ()
   -- modules currently cannot be nested (should this be allowed?)
   link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
@@ -286,7 +284,7 @@ mergeEType (EType t1 ps1 cs1) (EType t2 ps2 cs2)
 -- merge two general types
 mergeTypeUs :: TypeU -> TypeU -> MorlocMonad TypeU
 mergeTypeUs t1 t2
-  | PO.equivalent t1 t2 = return t1
+  | equivalent t1 t2 = return t1
   | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
 
 
@@ -334,45 +332,6 @@ collect gi v = do
 collectAnnoS :: ExprI -> MorlocMonad (AnnoS Int ManyPoly Int)
 collectAnnoS e@(ExprI gi _) = AnnoS gi gi <$> collectExprS e
 
--- -- | This function will handle terms that have been set to be equal
--- replaceExpr :: Int -> ExprI -> MorlocMonad [(ExprS Int ManyPoly Int, Int)]
--- -- this will be a nested variable
--- -- e.g.:
--- --   foo = bar
--- replaceExpr i e@(ExprI j (VarE _)) = do
---   x <- collectAnnoS e
---   -- unify the data between the equated terms
---   tiMay <- MM.metaMonomorphicTermTypes i
---   tjMay <- MM.metaMonomorphicTermTypes j
---   t <- case (tiMay, tjMay) of
---     (Just ti, Just tj) -> combineTermTypes ti tj
---     (Just ti, _) -> return ti
---     (_, Just tj) -> return tj
---     _ -> error "You shouldn't have done that"
---
---   st <- MM.get
---
---   case GMap.change i (Monomorphic t) (stateSignatures st) of
---     (Just m) -> MM.modify (\s -> s {stateSignatures = m})
---     _ -> error "impossible"
---
---   case GMap.yIsX j i (stateSignatures st) of
---     (Just m) -> MM.put (st {stateSignatures = m})
---     Nothing -> return ()
---
---   -- pass on just the children
---   case x of
---     (AnnoS (Many es) _) -> return es
---
---
--- -- -- two terms may also be equivalent when applied, for example:
--- -- --   foo x = bar x
--- -- -- this would be rewritten in the parse as `foo = \x -> bar x`
--- -- -- meaning foo and bar are equivalent after eta-reduction
--- -- replaceExpr i e@(ExprI _ (LamE vs (ExprI _ (AppE e2@(ExprI _ (VarE _)) xs))))
--- --     | map VarE vs == [v | (ExprI _ v) <- xs] = replaceExpr i e2
--- --     | otherwise = return <$> collectSExpr e
--- replaceExpr _ e = return <$> collectExprS e
 
 -- | Translate ExprI to ExprS tree
 collectExprS :: ExprI -> MorlocMonad (ExprS Int ManyPoly Int)
@@ -394,7 +353,7 @@ collectExprS (ExprI gi e0) = f e0 where
 
       -- A polymorphic term should always have a type.
       (GMapJust (Polymorphic cls clsName t ts)) -> do
-        MM.sayVVV $ "  polymorphic:" <+> list (map (maybe "?" pretty . termGeneral) ts) 
+        MM.sayVVV $ "  polymorphic:" <+> list (map (maybe "?" pretty . termGeneral) ts)
         ess <- mapM termtypesToAnnoS ts
         let etypes = map (fromJust . termGeneral) ts
         return $ VarS v (PolymorphicExpr cls clsName t (zip etypes ess))
@@ -433,7 +392,7 @@ collectExprS (ExprI gi e0) = f e0 where
   f ExpE{} = undefined
   f SrcE{} = undefined
   f SigE{} = undefined
-  f (AssE v _ _) = error $ "Found an unexpected ass in collectExprS: " <> show v 
+  f (AssE v _ _) = error $ "Found an unexpected ass in collectExprS: " <> show v
 
 reindexExprI :: ExprI -> MorlocMonad ExprI
 reindexExprI (ExprI i e) = ExprI <$> newIndex i <*> reindexExpr e
@@ -560,7 +519,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
         -> (Typeclass, [TVar], EType, [TermTypes])
         -> (Typeclass, [TVar], EType, [TermTypes])
       mergeInstances (cls1, vs1, e1, ts1) (cls2, vs2, e2, ts2)
-        | cls1 == cls2, length vs1 == length vs2, PO.equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
+        | cls1 == cls2, length vs1 == length vs2, equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
         | otherwise = error "failed to merge"
 
       requalify :: [TVar] -> TypeU -> TypeU
@@ -643,7 +602,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
 
       mergeSignatureSet :: SignatureSet -> SignatureSet -> MorlocMonad SignatureSet
       mergeSignatureSet (Polymorphic cls1 v1 t1 ts1) (Polymorphic cls2 v2 t2 ts2)
-        | cls1 == cls2 && PO.equivalent (etype t1) (etype t2) && v1 == v2 = return $ Polymorphic cls1 v1 t1 (unionTermTypes ts1 ts2)
+        | cls1 == cls2 && equivalent (etype t1) (etype t2) && v1 == v2 = return $ Polymorphic cls1 v1 t1 (unionTermTypes ts1 ts2)
         | otherwise = error "Invalid SignatureSet merge"
       mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> combineTermTypes ts1 ts2
       mergeSignatureSet _ _ = undefined
@@ -654,7 +613,7 @@ unionTermTypes ts1 ts2 = foldr mergeTermTypes ts2 ts1
 
 mergeTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
 mergeTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
-  | PO.equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
+  | equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
   | otherwise = t2 : mergeTermTypes t1 ts
 mergeTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
   mergeTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
@@ -669,7 +628,7 @@ mergeTypeclasses
   -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
 mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
   | cls1 /= cls2 = error "Conflicting typeclasses"
-  | not (PO.equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
+  | not (equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
   | length vs1 /= length vs2 = error "Conflicting typeclass parameter count"
   -- here I should do reciprocal subtyping
   | otherwise = return (cls1, vs1, t1, unionTermTypes ts1 ts2)
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index d82d9a3d..86dc10a7 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -13,13 +13,11 @@ module Morloc.Frontend.Typecheck (typecheck, resolveTypes, evaluateAnnoSTypes, p
 
 import Morloc.Frontend.Namespace
 import Morloc.Typecheck.Internal
-import Morloc.Pretty
 import Morloc.Data.Doc
 import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Data.GMap as GMap
 import qualified Morloc.Monad as MM
 import qualified Morloc.TypeEval as TE
-import qualified Morloc.Frontend.PartialOrder as MTP
 
 import qualified Data.Map as Map
 
@@ -78,17 +76,17 @@ resolveTypes (AnnoS (Idx i t) ci e)
 
 resolveInstances :: Gamma -> AnnoS (Indexed TypeU) ManyPoly Int -> MorlocMonad (AnnoS (Indexed TypeU) Many Int)
 resolveInstances g (AnnoS gi@(Idx _ gt) ci e0) = AnnoS gi ci <$> f e0 where
-  f :: ExprS (Indexed TypeU) ManyPoly Int -> MorlocMonad (ExprS (Indexed TypeU) Many Int) 
+  f :: ExprS (Indexed TypeU) ManyPoly Int -> MorlocMonad (ExprS (Indexed TypeU) Many Int)
 
   -- resolve instances
   f (VarS v (PolymorphicExpr _ _ _ rss)) = do
         -- collect all implementations and apply context
     let es = [AnnoS (Idx i (apply g t)) c e | (AnnoS (Idx i t) c e) <- concatMap snd rss]
         -- find the types of the most specific instances that are subtypes of the inferred type
-        mostSpecificTypes = MTP.mostSpecificSubtypes gt [t | (AnnoS (Idx _ t) _ _) <- es]
+        mostSpecificTypes = mostSpecificSubtypes gt [t | (AnnoS (Idx _ t) _ _) <- es]
         -- filter out the most specific subtype expressions
         es' = [AnnoS (Idx i t) c e | (AnnoS (Idx i t) c e) <- es, t `elem` mostSpecificTypes]
-    VarS v . Many <$> mapM (resolveInstances g) es' 
+    VarS v . Many <$> mapM (resolveInstances g) es'
 
   f (VarS v (MonomorphicExpr _ xs)) = VarS v . Many <$> mapM (resolveInstances g) xs
 
@@ -108,7 +106,7 @@ resolveInstances g (AnnoS gi@(Idx _ gt) ci e0) = AnnoS gi ci <$> f e0 where
   f (LogS x) = return $ LogS x
   f (StrS x) = return $ StrS x
   f (CallS x) = return $ CallS x
-  
+
 
 -- prepare a general, indexed typechecking error
 gerr :: Int -> TypeError -> MorlocMonad a
@@ -164,18 +162,18 @@ synthE i g0 (AccS k e) = do
     accessRecord :: Gamma -> TypeU -> MorlocMonad (Gamma, TypeU)
     accessRecord g t@(NamU _ _ _ rs) = case lookup k rs of
       Nothing -> gerr i (KeyError k t)
-      (Just val) -> return (g, val)
+      (Just value) -> return (g, value)
     accessRecord g t@(ExistU v ps rs) = case lookup k rs of
       Nothing -> do
-        let (g', val) = newvar (unTVar v <> "_" <> unKey k) g
+        let (g', value) = newvar (unTVar v <> "_" <> unKey k) g
         case access1 v (gammaContext g') of
-          (Just (rhs, _, lhs)) -> return (g' { gammaContext = rhs <> [ExistG v ps ((k, val):rs)] <> lhs }, val)
+          (Just (rhs, _, lhs)) -> return (g' { gammaContext = rhs <> [ExistG v ps ((k, value):rs)] <> lhs }, value)
           Nothing -> do
             MM.sayVVV $ "Case b"
                       <> "\n  rs:" <+> pretty rs
                       <> "\n  v:" <+> pretty v
             gerr i (KeyError k t)
-      (Just val) -> return (g, val)
+      (Just value) -> return (g, value)
     accessRecord g t = do
       globalMap <- MM.gets stateGeneralTypedefs
       gscope <- case GMap.lookup i globalMap of
@@ -287,7 +285,7 @@ synthE _ g0 (NamS rs) = do
 -- variables should be checked against. I think (this needs formalization).
 synthE _ g0 (VarS v (MonomorphicExpr (Just t0) xs0)) = do
   let (g1, t1) = rename g0 (etype t0)
-  (g2, t2, xs1) <- foldCheck g1 xs0 t1 
+  (g2, t2, xs1) <- foldCheck g1 xs0 t1
   let xs2 = applyCon g2 $ VarS v (MonomorphicExpr (Just t0) xs1)
   return (g2, t2, xs2)
 
@@ -300,7 +298,7 @@ synthE _ g (VarS v (MonomorphicExpr Nothing (x:xs))) = do
 synthE _ g (VarS v (MonomorphicExpr Nothing [])) = do
   let (g', t) = newvar (unEVar v <> "_u") g
   return (g', t, VarS v (MonomorphicExpr Nothing []))
-  
+
 synthE i g0 (VarS v (PolymorphicExpr cls clsName t0 rs0)) = do
   let (g1, t1) = toExistential g0 (etype t0)
   rs' <- checkInstances g1 t1 rs0
@@ -337,16 +335,16 @@ synthE i g0 (VarS v (PolymorphicExpr cls clsName t0 rs0)) = do
 
 -- This case will only be encountered in check, the existential generated here
 -- will be subtyped against the type known from the VarS case.
-synthE _ g (CallS src) = do 
+synthE _ g (CallS src) = do
   let (g', t) = newvar "call_" g
   return (g', t, CallS src)
 
 synthE _ g (BndS v) = do
-  (g', t') <- case lookupE v g of 
+  (g', t') <- case lookupE v g of
     -- yes, return the solved type
     (Just t) -> return (g, t)
     -- no, then I don't know what it is and will return an existential
-    -- if this existential is never solved, then it will become universal later 
+    -- if this existential is never solved, then it will become universal later
     Nothing -> return $ newvar (unEVar v <> "_u") g
   return (g', t', BndS v)
 
@@ -481,7 +479,7 @@ foldCheck
   -> MorlocMonad (Gamma, TypeU, [AnnoS (Indexed TypeU) ManyPoly Int])
 foldCheck g [] t = return (g, t, [])
 foldCheck g (x:xs) t = do
-  (g', t', x') <- checkG g x t  
+  (g', t', x') <- checkG g x t
   (g'', t'', xs') <- foldCheck g' xs t'
   return (g'', t'', x':xs')
 
@@ -565,6 +563,16 @@ evaluateAnnoSTypes = mapAnnoSGM resolve where
 
 ---- debugging
 
+
+synthE'
+  :: Int
+  -> Gamma
+  -> ExprS Int ManyPoly Int
+  -> MorlocMonad
+       ( Gamma
+       , TypeU
+       , ExprS (Indexed TypeU) ManyPoly Int
+       )
 synthE' i g x = do
   enter "synthE"
   insetSay $ "synthesize type for: " <> peakSExpr x
@@ -574,6 +582,17 @@ synthE' i g x = do
   insetSay $ "synthesized type = " <> pretty t
   return r
 
+
+checkE'
+  :: Int
+  -> Gamma
+  -> ExprS Int ManyPoly Int
+  -> TypeU
+  -> MorlocMonad
+       ( Gamma
+       , TypeU
+       , ExprS (Indexed TypeU) ManyPoly Int
+       )
 checkE' i g x t = do
   enter "checkE"
   insetSay $ "check if expr: " <> peakSExpr x
@@ -584,6 +603,17 @@ checkE' i g x t = do
   seeType t'
   return r
 
+
+application'
+  :: Int
+  -> Gamma
+  -> [AnnoS Int ManyPoly Int]
+  -> TypeU
+  -> MorlocMonad
+      ( Gamma
+      , TypeU
+      , [AnnoS (Indexed TypeU) ManyPoly Int]
+      )
 application' i g es t = do
   enter "application"
   seeType t
diff --git a/library/Morloc/Internal.hs b/library/Morloc/Internal.hs
index c21f5a41..c0f8f9fe 100644
--- a/library/Morloc/Internal.hs
+++ b/library/Morloc/Internal.hs
@@ -44,7 +44,7 @@ module Morloc.Internal
   , (</>) -- Filesystem utility operators from System.FilePath
   , (<|>) -- alternative operator
   , (&&&) -- (a -> a') -> (b -> b') -> (a, b) -> (a', b')
-  , (***) -- (a -> b) -> (a -> c) -> a -> (b, c) 
+  , (***) -- (a -> b) -> (a -> c) -> a -> (b, c)
   -- ** map and set helper functions
   , keyset
   , valset
@@ -112,7 +112,7 @@ minimumOnDef :: Ord b => a -> (a -> b) -> [a] -> a
 minimumOnDef x _ [] = x
 minimumOnDef _ f xs = minimumOn f xs
 
-uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d 
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
 uncurry3 f (x, y, z) = f x y z
 
 curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
@@ -145,14 +145,14 @@ concatMapM f = fmap concat . mapM f
 
 -- | remove duplicated elements in a list while preserving order
 unique :: Ord a => [a] -> [a]
-unique = unique' Set.empty where 
+unique = unique' Set.empty where
   unique' _   [] = []
   unique' set (x:xs)
     | Set.member x set = unique' set xs
     | otherwise = x : unique' (Set.insert x set) xs
 
 -- | Build an ordered list of duplicated elements
-duplicates :: Ord a => [a] -> [a] 
+duplicates :: Ord a => [a] -> [a]
 duplicates xs = unique $ filter isDuplicated xs where
   -- countMap :: Ord a => Map.Map a Int
   countMap = Map.fromList . map (\ks -> (head ks, length ks)) . group . sort $ xs
@@ -179,21 +179,21 @@ statefulMapM f s (x:xs) = do
 filterApart :: (a -> Bool) -> [a] -> (Maybe a, [a])
 filterApart _ [] = (Nothing, [])
 filterApart f (x:xs)
-  | f x = (Just x, xs)  
-  | otherwise = case filterApart f xs of 
-    (r, xs') -> (r, x:xs') 
+  | f x = (Just x, xs)
+  | otherwise = case filterApart f xs of
+    (r, xs') -> (r, x:xs')
 
 safeZip :: [a] -> [b] -> Maybe [(a, b)]
 safeZip (x:xs) (y:ys) = (:) (x,y) <$> safeZip xs ys
 safeZip [] [] = Just []
 safeZip _ _ = Nothing
 
-safeZipWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c] 
+safeZipWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
 safeZipWith f xs ys
     | length xs == length ys = Just $ zipWith f xs ys
     | otherwise = Nothing
 
-safeZipWithM :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m (Maybe [c]) 
+safeZipWithM :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m (Maybe [c])
 safeZipWithM f xs ys
     | length xs == length ys = zipWithM f xs ys |>> Just
     | otherwise = return Nothing
diff --git a/library/Morloc/Language.hs b/library/Morloc/Language.hs
index d94c3a54..d12b0b62 100644
--- a/library/Morloc/Language.hs
+++ b/library/Morloc/Language.hs
@@ -30,6 +30,7 @@ module Morloc.Language
   ) where
 
 import Data.Text (Text, toLower)
+import Morloc.Data.Doc
 
 -- | Programming languages in the Morloc ecosystem. This is the type that
 -- should be used to refer to a language (don't use raw strings). Some of these
@@ -43,6 +44,9 @@ data Lang
   | PerlLang
   deriving (Ord, Eq, Show)
 
+instance Pretty Lang where
+  pretty = viaShow
+
 serialType :: Lang -> Text
 serialType CppLang = "std::string"
 serialType RLang = "character"
diff --git a/library/Morloc/Module.hs b/library/Morloc/Module.hs
index 29be1d38..8c970196 100644
--- a/library/Morloc/Module.hs
+++ b/library/Morloc/Module.hs
@@ -3,7 +3,7 @@
 
 {-|
 Module      : Module
-Description : Morloc module imports and paths 
+Description : Morloc module imports and paths
 Copyright   : (c) Zebulun Arendsee, 2021
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
@@ -30,26 +30,9 @@ import qualified Morloc.Config as Config
 import qualified Morloc.Data.Text as MT
 import qualified Morloc.Monad as MM
 import qualified Morloc.System as MS
-
-import Data.Aeson (FromJSON(..), (.!=), (.:?), withObject)
 import qualified Data.Yaml.Config as YC
 
-instance FromJSON PackageMeta where
-  parseJSON = withObject "object" $ \o ->
-    PackageMeta <$> o .:? "name"        .!= ""
-                <*> o .:? "version"     .!= ""
-                <*> o .:? "homepage"    .!= ""
-                <*> o .:? "synopsis"    .!= ""
-                <*> o .:? "description" .!= ""
-                <*> o .:? "category"    .!= ""
-                <*> o .:? "license"     .!= ""
-                <*> o .:? "author"      .!= ""
-                <*> o .:? "maintainer"  .!= ""
-                <*> o .:? "github"      .!= ""
-                <*> o .:? "bug-reports" .!= ""
-                <*> o .:? "gcc-flags"   .!= ""
-
--- | Specify where a module is located 
+-- | Specify where a module is located
 data ModuleSource
   = LocalModule (Maybe String)
   -- ^ A module in the working directory
@@ -81,7 +64,7 @@ findModule currentModuleM importModule = do
 
 -- | Give a module path (e.g. "/your/path/foo.loc") find the package metadata.
 -- It currently only looks for a file named "package.yaml" in the same folder
--- as the main "*.loc" file. 
+-- as the main "*.loc" file.
 findModuleMetadata :: Path -> IO (Maybe Path)
 findModuleMetadata mainFile =
   getFile $ MS.combine (MS.takeDirectory mainFile) "package.yaml"
@@ -111,7 +94,7 @@ commonPrefix _ _ = []
 removePathSuffix :: [String] -> [String] -> [String]
 removePathSuffix [] ys = ys
 removePathSuffix _ [] = []
-removePathSuffix xs ys 
+removePathSuffix xs ys
     | stringPath (last xs) == stringPath (last ys) = removePathSuffix (init xs) (init ys)
     | otherwise = ys
     where
@@ -232,10 +215,10 @@ getHeaderPaths lib base exts = [path <> ext | path <- paths, ext <- exts]
   where
     paths = map MS.joinPath
             [ [base]
-            , ["include", base] 
+            , ["include", base]
             , [base, base]
             , [lib, "include", base]
-            , [lib, "src", base, base] 
+            , [lib, "src", base, base]
             , ["/usr/include", base]
             , ["/usr/local/include", base]
             ]
@@ -261,7 +244,7 @@ handleFlagsAndPaths :: Lang -> [Source] -> MorlocMonad ([Source], [MT.Text], [Pa
 handleFlagsAndPaths CppLang srcs = do
   state <- MM.get
   let gccflags = filter (/= "") . map packageGccFlags $ statePackageMeta state
-  
+
   (srcs', libflags, paths) <-
       fmap unzip3
     . mapM flagAndPath
@@ -279,7 +262,7 @@ handleFlagsAndPaths CppLang srcs = do
          -- compiler flags and shared libraries
          , gccflags ++ (map MT.pack . concat) (mlcInclude : libflags)
          -- paths to files to include
-         , unique (catMaybes paths) 
+         , unique (catMaybes paths)
          )
 handleFlagsAndPaths _ srcs = return (srcs, [], [])
 
diff --git a/library/Morloc/Monad.hs b/library/Morloc/Monad.hs
index 45778bdd..eccef3cb 100644
--- a/library/Morloc/Monad.hs
+++ b/library/Morloc/Monad.hs
@@ -69,7 +69,6 @@ import Control.Monad.State
 import Control.Monad.Trans
 import Control.Monad.Writer
 import Control.Monad.Identity
-import Morloc.Error () -- for MorlocError Show instance
 import Morloc.Namespace
 import Morloc.Data.Doc
 import System.IO (stderr)
@@ -87,26 +86,6 @@ runMorlocMonad ::
 runMorlocMonad outfile v config ev =
   runStateT (runWriterT (runExceptT (runReaderT ev config))) (emptyState outfile v)
 
-instance Defaultable MorlocState where
-  defaultValue = MorlocState {
-      statePackageMeta = []
-    , stateVerbosity = 0
-    , stateCounter = -1
-    , stateDepth = 0
-    , stateSignatures = GMap.empty
-    , stateConcreteTypedefs = GMap.empty
-    , stateGeneralTypedefs = GMap.empty
-    , stateUniversalConcreteTypedefs = Map.empty
-    , stateUniversalGeneralTypedefs = Map.empty
-    , stateInnerMogrifiers = GMap.empty
-    , stateUniversalInnerMogrifiers = Map.empty
-    , stateSources = GMap.empty
-    , stateAnnotations = Map.empty
-    , stateOutfile = Nothing
-    , stateExports = []
-    , stateName = Map.empty
-  }
-
 emptyState :: Maybe Path -> Int -> MorlocState
 emptyState path v = defaultValue
   { stateVerbosity = v
@@ -198,7 +177,7 @@ sayV = sayIf 1
 -- print for verbose level 2
 -- messages for the programmer
 sayVV :: MDoc -> MorlocMonad ()
-sayVV = sayIf 2 
+sayVV = sayIf 2
 
 -- print for verbose level 3
 -- really boring shit that probably no one wants to ever hear, but we spent a
@@ -291,7 +270,7 @@ metaSources i = do
 -- are not used anywhere yet.
 metaConstraints :: Int -> MorlocMonad [Constraint]
 metaConstraints i = do
-  s <- gets stateSignatures 
+  s <- gets stateSignatures
   return $ case GMap.lookup i s of
     (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (econs e)
     (GMapJust (Polymorphic _ _ e _)) -> Set.toList (econs e)
@@ -302,7 +281,7 @@ metaConstraints i = do
 -- properties will be part of the typeclass system.
 metaProperties :: Int -> MorlocMonad [Property]
 metaProperties i = do
-  s <- gets stateSignatures 
+  s <- gets stateSignatures
   return $ case GMap.lookup i s of
     (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (eprop e)
     (GMapJust (Polymorphic _ _ e _)) -> Set.toList (eprop e)
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index 070c7cb5..b5d16eca 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -107,8 +107,16 @@ module Morloc.Namespace
   -- , Decomposable(..)
   -- ** kludge
   , newVariable
+  -- Partial order logic
+  , isSubtypeOf
+  , equivalent
+  , mostGeneral
+  , mostSpecific
+  , mostSpecificSubtypes
   ) where
 
+import Morloc.Language (Lang(..))
+
 import Control.Monad.Except (ExceptT)
 import Control.Monad.Reader (ReaderT)
 import Control.Monad.State (StateT)
@@ -118,16 +126,55 @@ import Data.Map.Strict (Map)
 import Data.Monoid
 import Data.Scientific (Scientific)
 import Data.Text (Text)
-import Prettyprinter (Doc)
 import Data.Void (Void)
 import Morloc.Internal
 import Text.Megaparsec (ParseErrorBundle)
 import System.Directory.Tree (DirTree(..), AnchoredDirTree(..))
-import Morloc.Language (Lang(..))
+import Text.Megaparsec.Error (errorBundlePretty)
+import qualified Data.PartialOrd as P
+import qualified Data.List as DL
+import Data.Aeson (FromJSON(..), (.!=), (.:?), withObject)
 
+import Morloc.Data.Doc
 import qualified Data.Set as Set
+import qualified Data.Map as Map
 import qualified Data.Text as DT
 
+---- Typeclasses
+
+class Typelike a where
+  typeOf :: a -> Type
+
+  free :: a -> Set.Set a
+
+  -- | substitute all appearances of a given variable with a given new type
+  substituteTVar :: TVar -> a -> a -> a
+
+  nargs :: a -> Int
+  nargs (typeOf -> FunT ts _) = length ts
+  nargs _ = 0
+
+  -- | Curry function types. This converts types like `a -> (a -> a)` to
+  -- `a -> a -> a`. Ideally, this should not be necessary, since these are
+  -- equivalent types. Ideally, this equivalence would be deeply baked into
+  -- the system and I wouldn't have to worry about fixing it ...
+  -- FIXME: make it so
+  normalizeType :: a -> a
+
+class HasOneLanguage a where
+  langOf :: a -> Maybe Lang
+  langOf' :: a -> Lang
+
+  langOf x = Just (langOf' x)
+  langOf' x = fromJust (langOf x)
+
+class Defaultable a where
+  defaultValue :: a
+
+
+---- Type definitions
+
+
 -- | no annotations for now
 type MDoc = Doc ()
 
@@ -147,17 +194,15 @@ data GMapRet c
   | GMapJust c
   deriving(Show, Ord, Eq)
 
-class Defaultable a where
-  defaultValue :: a
-
 type MorlocMonadGen c e l s a
    = ReaderT c (ExceptT e (WriterT l (StateT s IO))) a
 
 type MorlocReturn a = ((Either MorlocError a, [Text]), MorlocState)
 
-data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EVar EType [TermTypes]  
+data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EVar EType [TermTypes]
   deriving(Show)
 
+
 data MorlocState = MorlocState
   { statePackageMeta :: [PackageMeta]
   -- ^ The parsed contents of a package.yaml file
@@ -213,7 +258,7 @@ data MorlocState = MorlocState
     /     \          of the set from all things to one kind of thing
    A+c1    B+c2    - The problem with the generic `a` being specialized into A and B and then being
     \     /   \      imported is that probably the intersection between A and B is empty. But maybe
-     \   /     \      it would make more sense for the result to be a union type, where X may be 
+     \   /     \      it would make more sense for the result to be a union type, where X may be
       \ /       \      either A or B. And which it is is determined at compile time from context.
        X         B+c4    Maybe A and B are two representations of the same thing, like a `map` type
       ---        ----     may be represented as either `[(a,b)]` or `([a]_n,[b]_n)`.
@@ -262,6 +307,7 @@ data TermTypes = TermTypes {
 } deriving (Show)
 
 
+
 -- | Distinguishes between term and type symbols in import/export expression
 -- before they are separated in Treeify.
 data Symbol = TypeSymbol TVar | TermSymbol EVar
@@ -357,7 +403,7 @@ data Script =
     { scriptBase :: !String -- ^ script basename (no extension)
     , scriptLang :: !Lang -- ^ script language
     , scriptCode :: !(AnchoredDirTree Code) -- ^ file tree containing all code and metadata
-    , scriptMake :: ![SysCommand] -- ^ Bash code to build the script 
+    , scriptMake :: ![SysCommand] -- ^ Bash code to build the script
     }
   deriving (Show, Ord, Eq)
 
@@ -385,96 +431,6 @@ data Gamma = Gamma
   , gammaContext :: [GammaIndex]
   }
 
-data TypeError
-  = SubtypeError TypeU TypeU Text
-  | InstantiationError TypeU TypeU Text
-  | EmptyCut GammaIndex
-  | OccursCheckFail TypeU TypeU Text
-    -- ^ the msg should an identifier for the place where the occurs check failed
-  | Mismatch TypeU TypeU Text
-  | UnboundVariable EVar
-  | KeyError Key TypeU
-  | MissingConcreteSignature EVar Lang
-  | MissingGeneralSignature EVar
-  | ApplicationOfNonFunction
-  | TooManyArguments
-  | EmptyExpression EVar
-  | MissingFeature Text
-  | InfiniteRecursion
-  | FunctionSerialization EVar
-
-data MorlocError
-  -- | An error that is associated with an expression index
-  = IndexedError Int MorlocError
-  -- | Raised for calls to unimplemented features
-  | NotImplemented Text
-  -- | Raised for unsupported features (such as specific languages)
-  | NotSupported Text
-  -- | Raised by parsec on parse errors
-  | SyntaxError (ParseErrorBundle Text Void)
-  -- | Raised when an unsupported language is encountered
-  | UnknownLanguage Text
-  -- | Raised when a module cannot be loaded 
-  | CannotLoadModule Text
-  -- | System call failed
-  | SystemCallError Text Text Text
-  -- | Raised when there is an error in the code generators
-  | GeneratorError Text
-  -- | Missing a serialization or deserialization function
-  | SerializationError Text
-  -- | Error in building a pool (i.e., in a compiled language)
-  | PoolBuildError Text
-  -- | Raise when a type alias substitution fails
-  | SelfRecursiveTypeAlias TVar
-  | MutuallyRecursiveTypeAlias [Text]
-  | BadTypeAliasParameters TVar Int Int 
-  | ConflictingTypeAliases TypeU TypeU
-  -- | Problems with the directed acyclic graph datastructures
-  | DagMissingKey Text
-  -- | Raised when a branch is reached that should not be possible
-  | CallTheMonkeys Text
-  --------------- T Y P E   E R R O R S --------------------------------------
-  | ConcreteTypeError TypeError
-  | GeneralTypeError TypeError
-  | ToplevelRedefinition
-  | IncompatibleGeneralType TypeU TypeU
-  | OtherError Text -- TODO: remove this option
-  -- container errors
-  | EmptyTuple
-  | TupleSingleton
-  | EmptyRecord
-  -- module errors
-  | MultipleModuleDeclarations [MVar]
-  | NestedModule MVar
-  | NonSingularRoot [MVar]
-  | ImportExportError MVar Text
-  | CannotFindModule MVar
-  | CyclicDependency
-  | SelfImport MVar
-  | BadRealization
-  | TooManyRealizations
-  | MissingSource
-  -- type extension errors
-  | UndefinedType TVar
-  | AmbiguousPacker Text
-  | AmbiguousUnpacker Text
-  | AmbiguousCast Text Text
-  | IllegalPacker TypeU
-  | CyclicPacker TypeU TypeU
-  | ConflictingPackers TypeU TypeU
-  | IncompatibleRealization MVar
-  | MissingAbstractType
-  | ExpectedAbstractType
-  | CannotInferConcretePrimitiveType
-  | ToplevelStatementsHaveNoLanguage
-  | InconsistentWithinTypeLanguage
-  | CannotInferLanguageOfEmptyRecord
-  | ConflictingSignatures
-  | CompositionsMustBeGeneral
-  | IllegalConcreteAnnotation
-  -- type synthesis errors
-  | CannotSynthesizeConcreteType MVar Source TypeU [Text]
-
 data PackageMeta =
   PackageMeta
     { packageName :: !Text
@@ -492,22 +448,6 @@ data PackageMeta =
     }
   deriving (Show, Ord, Eq)
 
-instance Defaultable PackageMeta where
-  defaultValue = PackageMeta
-    { packageName = ""
-    , packageVersion = ""
-    , packageHomepage = ""
-    , packageSynopsis = ""
-    , packageDescription = ""
-    , packageCategory = ""
-    , packageLicense = ""
-    , packageAuthor = ""
-    , packageMaintainer = ""
-    , packageGithub = ""
-    , packageBugReports = ""
-    , packageGccFlags = ""
-    }
-
 -- | Configuration object that is passed with MorlocMonad
 data Config =
   Config
@@ -533,6 +473,7 @@ newtype MVar = MV { unMVar :: Text } deriving (Show, Eq, Ord)
 -- A term name
 newtype EVar = EV { unEVar :: Text } deriving (Show, Eq, Ord)
 
+
 -- A type general name
 newtype TVar = TV { unTVar :: Text } deriving (Show, Eq, Ord)
 
@@ -564,12 +505,11 @@ data Source =
     , srcAlias :: EVar
       -- ^ the morloc alias for the function (if no alias is explicitly given,
       -- this will be equal to the name
-    , srcLabel :: Maybe Label 
+    , srcLabel :: Maybe Label
       -- ^ an additional label for distinguishing this term from its synonyms
     }
   deriving (Ord, Eq, Show)
 
-
 data AnnoS g f c = AnnoS g c (ExprS g f c)
 
 data ExprS g f c
@@ -588,66 +528,6 @@ data ExprS g f c
   | StrS Text
   | CallS Source
 
-
-mapExprSM :: (Traversable f, Monad m) => (AnnoS g f c -> m (AnnoS g' f c')) -> ExprS g f c -> m (ExprS g' f c')
-mapExprSM f (VarS v xs) = VarS v <$> traverse f xs
-mapExprSM f (AccS k x) = AccS k <$> f x
-mapExprSM f (AppS x xs) = AppS <$> f x <*> mapM f xs
-mapExprSM f (LamS vs x) = LamS vs <$> f x
-mapExprSM f (LstS xs) = LstS <$> mapM f xs
-mapExprSM f (TupS xs) = TupS <$> mapM f xs
-mapExprSM f (NamS rs) = NamS <$> mapM (secondM f) rs
-mapExprSM _ UniS = return UniS
-mapExprSM _ (BndS v) = return $ BndS v
-mapExprSM _ (RealS x) = return $ RealS x
-mapExprSM _ (IntS x) = return $ IntS x
-mapExprSM _ (LogS x) = return $ LogS x
-mapExprSM _ (StrS x) = return $ StrS x
-mapExprSM _ (CallS x) = return $ CallS x
-
-mapAnnoSM :: (Traversable f, Monad m) => (ExprS g f c -> g -> c -> m (g', c')) -> AnnoS g f c -> m (AnnoS g' f c')
-mapAnnoSM fun (AnnoS g c e) = do
-  e' <- mapExprSM (mapAnnoSM fun) e
-  (g', c') <- fun e g c
-  return (AnnoS g' c' e')
-
-mapAnnoS :: (Traversable f) => (ExprS g f c -> g -> c -> (g', c')) -> AnnoS g f c -> AnnoS g' f c'
-mapAnnoS fun = runIdentity . mapAnnoSM (\x g c -> return (fun x g c))
-
-mapExprS :: (Traversable f) => (AnnoS g f c -> AnnoS g' f c') -> ExprS g f c -> ExprS g' f c'
-mapExprS fun = runIdentity . mapExprSM (return . fun)
-
-mapAnnoSGM :: (Traversable f, Monad m) => (g -> m g') -> AnnoS g f c -> m (AnnoS g' f c)
-mapAnnoSGM f = mapAnnoSM (\_ gi ci -> (,) <$> f gi <*> pure ci)
-
-mapAnnoSCM :: (Traversable f, Monad m) => (c -> m c') -> AnnoS g f c -> m (AnnoS g f c')
-mapAnnoSCM f = mapAnnoSM (\_ gi ci -> (,) gi <$> f ci)
-
-mapAnnoSG :: (Traversable f) => (g -> g') -> AnnoS g f c -> AnnoS g' f c
-mapAnnoSG f = mapAnnoS (\_ gi ci -> (f gi, ci))
-
-mapAnnoSC :: (Traversable f) => (c -> c') -> AnnoS g f c -> AnnoS g f c'
-mapAnnoSC f = mapAnnoS (\_ gi ci -> (gi, f ci))
-
-mapExprSGM :: (Traversable f, Monad m) => (g -> m g') -> ExprS g f c -> m (ExprS g' f c)
-mapExprSGM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS <$> f gi <*> pure ci <*> mapExprSGM f e)
-
-mapExprSCM :: (Traversable f, Monad m) => (c -> m c') -> ExprS g f c -> m (ExprS g f c')
-mapExprSCM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS gi <$> f ci <*> mapExprSCM f e)
-
-mapExprSG :: (Traversable f) => (g -> g') -> ExprS g f c -> ExprS g' f c
-mapExprSG f = mapExprS (\(AnnoS gi ci e) -> AnnoS (f gi) ci (mapExprSG f e))
-
-mapExprSC :: (Traversable f) => (c -> c') -> ExprS g f c -> ExprS g f c'
-mapExprSC f = mapExprS (\(AnnoS gi ci e) -> AnnoS gi (f ci) (mapExprSC f e))
-
-
--- -- g: an annotation for the group of child trees (what they have in common)
--- -- f: a collection - before realization this will be Many
--- --                 - after realization it will be One
--- -- c: an annotation for the specific child tree
--- data SAnno g f c = SAnno (f (SExpr g f c, c)) g
-
 data Three a b c = A a | B b | C c
   deriving (Ord, Eq, Show)
 
@@ -666,64 +546,12 @@ data ManyPoly a = MonomorphicExpr (Maybe EType) [a] | PolymorphicExpr Typeclass
 data Or a b = L a | R b | LR a b
   deriving(Ord, Eq, Show)
 
-instance Functor One where
-  fmap f (One x) = One (f x)
-
-instance Functor Many where
-  fmap f (Many x) = Many (map f x)
-
-instance Functor ManyPoly where
-  fmap f (MonomorphicExpr t xs) = MonomorphicExpr t (map f xs)
-  fmap f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t (map (second (map f)) xs)
-
-instance Traversable One where
-  traverse f (One x) = One <$> f x
-
-instance Traversable Many where
-  traverse f (Many xs) = Many <$> traverse f xs
-
-instance Traversable ManyPoly where
-  traverse f (MonomorphicExpr t xs) = MonomorphicExpr t <$> traverse f xs
-  traverse f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t <$> traverse f2 xs where
-    f2 (t', x) = (,) t' <$> traverse f x
-
-instance Foldable One where
-  foldr f b (One a) = f a b
-
-instance Foldable Many where
-  foldr f b (Many xs) = foldr f b xs
-
-instance Foldable ManyPoly where
-  foldr f b (MonomorphicExpr _ xs) = foldr f b xs
-  foldr f b (PolymorphicExpr _ _ _ (concatMap snd -> xs)) = foldr f b xs
-
-instance Bifunctor Or where
-  bimapM f _ (L a) = L <$> f a
-  bimapM _ g (R a) = R <$> g a
-  bimapM f g (LR a b) = LR <$> f a <*> g b
-
-instance Bifoldable Or where
-  bilistM f _ (L a) = f a |>> return
-  bilistM _ g (R b) = g b |>> return
-  bilistM f g (LR a b) = do
-    c1 <- f a
-    c2 <- g b
-    return [c1, c2]
-
 
 type Indexed = IndexedGeneral Int
 
 data IndexedGeneral k a = Idx k a
   deriving (Show, Ord, Eq)
 
-instance Annotated IndexedGeneral where
-  val (Idx _ x) = x
-  ann (Idx i _) = i
-  annotate i x = Idx i x
-
-instance Functor (IndexedGeneral k) where
-  fmap f (Idx i x) = Idx i (f x)
-
 data NamType
   = NamRecord
   | NamObject
@@ -745,8 +573,8 @@ data Type
 
 -- | A type with existentials and universals
 data TypeU
-  = VarU TVar 
-  | ExistU TVar 
+  = VarU TVar
+  | ExistU TVar
     [TypeU] -- type parameters
     [(Key, TypeU)] -- key accesses into this type
   -- ^ (a^) will be solved into one of the other types
@@ -757,22 +585,6 @@ data TypeU
   | NamU NamType TVar [TypeU] [(Key, TypeU)] -- record / object / table
   deriving (Show, Ord, Eq)
 
-extractKey :: TypeU -> TVar
-extractKey (VarU v) = v
-extractKey (ForallU _ t) = extractKey t
-extractKey (AppU t _) = extractKey t
-extractKey (NamU _ v _ _) = v
-extractKey (ExistU v _ _) = v
-extractKey t = error $ "Cannot currently handle functional type imports: " <> show t
-
-
-type2typeu :: Type -> TypeU
-type2typeu (VarT v) = VarU v
-type2typeu (UnkT v) = ForallU v (VarU v) -- sus
-type2typeu (FunT ts t) = FunU (map type2typeu ts) (type2typeu t)
-type2typeu (AppT v ts) = AppU (type2typeu v) (map type2typeu ts)
-type2typeu (NamT o n ps rs) = NamU o n (map type2typeu ps) [(k, type2typeu x) | (k,x) <- rs]
-
 -- | Extended Type that may represent a language specific type as well as sets
 -- of properties and constrains.
 data EType =
@@ -783,18 +595,6 @@ data EType =
     }
   deriving (Show, Eq, Ord)
 
-instance HasOneLanguage Source where
-  langOf s = Just (srcLang s)
-  langOf' s = srcLang s
-
-unresolvedType2type :: TypeU -> Type 
-unresolvedType2type (VarU v) = VarT v
-unresolvedType2type ExistU {} = error "Cannot cast existential type to Type"
-unresolvedType2type (ForallU _ _) = error "Cannot cast universal type as Type"
-unresolvedType2type (FunU ts t) = FunT (map unresolvedType2type ts) (unresolvedType2type t)
-unresolvedType2type (AppU v ts) = AppT (unresolvedType2type v) (map unresolvedType2type ts)
-unresolvedType2type (NamU t n ps rs) = NamT t n (map unresolvedType2type ps) [(k, unresolvedType2type e) | (k, e) <- rs]
-
 
 data Property
   = Pack -- data structure to JSON
@@ -809,25 +609,222 @@ newtype Constraint =
   Con Text
   deriving (Show, Eq, Ord)
 
-class Typelike a where
-  typeOf :: a -> Type
+data TypeError
+  = SubtypeError TypeU TypeU Text
+  | InstantiationError TypeU TypeU Text
+  | EmptyCut GammaIndex
+  | OccursCheckFail TypeU TypeU Text
+    -- ^ the msg should an identifier for the place where the occurs check failed
+  | Mismatch TypeU TypeU Text
+  | UnboundVariable EVar
+  | KeyError Key TypeU
+  | MissingConcreteSignature EVar Lang
+  | MissingGeneralSignature EVar
+  | ApplicationOfNonFunction
+  | TooManyArguments
+  | EmptyExpression EVar
+  | MissingFeature Text
+  | InfiniteRecursion
+  | FunctionSerialization EVar
 
-  free :: a -> Set.Set a
+data MorlocError
+  -- | An error that is associated with an expression index
+  = IndexedError Int MorlocError
+  -- | Raised for calls to unimplemented features
+  | NotImplemented Text
+  -- | Raised for unsupported features (such as specific languages)
+  | NotSupported Text
+  -- | Raised by parsec on parse errors
+  | SyntaxError (ParseErrorBundle Text Void)
+  -- | Raised when an unsupported language is encountered
+  | UnknownLanguage Text
+  -- | Raised when a module cannot be loaded
+  | CannotLoadModule Text
+  -- | System call failed
+  | SystemCallError Text Text Text
+  -- | Raised when there is an error in the code generators
+  | GeneratorError Text
+  -- | Missing a serialization or deserialization function
+  | SerializationError Text
+  -- | Error in building a pool (i.e., in a compiled language)
+  | PoolBuildError Text
+  -- | Raise when a type alias substitution fails
+  | SelfRecursiveTypeAlias TVar
+  | MutuallyRecursiveTypeAlias [Text]
+  | BadTypeAliasParameters TVar Int Int
+  | ConflictingTypeAliases TypeU TypeU
+  -- | Problems with the directed acyclic graph datastructures
+  | DagMissingKey Text
+  -- | Raised when a branch is reached that should not be possible
+  | CallTheMonkeys Text
+  --------------- T Y P E   E R R O R S --------------------------------------
+  | ConcreteTypeError TypeError
+  | GeneralTypeError TypeError
+  | ToplevelRedefinition
+  | IncompatibleGeneralType TypeU TypeU
+  | OtherError Text -- TODO: remove this option
+  -- container errors
+  | EmptyTuple
+  | TupleSingleton
+  | EmptyRecord
+  -- module errors
+  | MultipleModuleDeclarations [MVar]
+  | NestedModule MVar
+  | NonSingularRoot [MVar]
+  | ImportExportError MVar Text
+  | CannotFindModule MVar
+  | CyclicDependency
+  | SelfImport MVar
+  | BadRealization
+  | TooManyRealizations
+  | MissingSource
+  -- type extension errors
+  | UndefinedType TVar
+  | AmbiguousPacker Text
+  | AmbiguousUnpacker Text
+  | AmbiguousCast Text Text
+  | IllegalPacker TypeU
+  | CyclicPacker TypeU TypeU
+  | ConflictingPackers TypeU TypeU
+  | IncompatibleRealization MVar
+  | MissingAbstractType
+  | ExpectedAbstractType
+  | CannotInferConcretePrimitiveType
+  | ToplevelStatementsHaveNoLanguage
+  | InconsistentWithinTypeLanguage
+  | CannotInferLanguageOfEmptyRecord
+  | ConflictingSignatures
+  | CompositionsMustBeGeneral
+  | IllegalConcreteAnnotation
+  -- type synthesis errors
+  | CannotSynthesizeConcreteType MVar Source TypeU [Text]
 
-  -- | substitute all appearances of a given variable with a given new type
-  substituteTVar :: TVar -> a -> a -> a
 
-  nargs :: a -> Int
-  nargs (typeOf -> FunT ts _) = length ts
-  nargs _ = 0
 
-  -- | Curry function types. This converts types like `a -> (a -> a)` to  
-  -- `a -> a -> a`. Ideally, this should not be necessary, since these are
-  -- equivalent types. Ideally, this equivalence would be deeply baked into
-  -- the system and I wouldn't have to worry about fixing it ...
-  -- FIXME: make it so
-  normalizeType :: a -> a
-  
+
+---- Fundamental class instances
+
+instance Functor (IndexedGeneral k) where
+  fmap f (Idx i x) = Idx i (f x)
+
+instance Functor One where
+  fmap f (One x) = One (f x)
+
+instance Functor Many where
+  fmap f (Many x) = Many (map f x)
+
+instance Functor ManyPoly where
+  fmap f (MonomorphicExpr t xs) = MonomorphicExpr t (map f xs)
+  fmap f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t (map (second (map f)) xs)
+
+instance Traversable One where
+  traverse f (One x) = One <$> f x
+
+instance Traversable Many where
+  traverse f (Many xs) = Many <$> traverse f xs
+
+instance Traversable ManyPoly where
+  traverse f (MonomorphicExpr t xs) = MonomorphicExpr t <$> traverse f xs
+  traverse f (PolymorphicExpr cls v t xs) = PolymorphicExpr cls v t <$> traverse f2 xs where
+    f2 (t', x) = (,) t' <$> traverse f x
+
+instance Foldable One where
+  foldr f b (One a) = f a b
+
+instance Foldable Many where
+  foldr f b (Many xs) = foldr f b xs
+
+instance Foldable ManyPoly where
+  foldr f b (MonomorphicExpr _ xs) = foldr f b xs
+  foldr f b (PolymorphicExpr _ _ _ (concatMap snd -> xs)) = foldr f b xs
+
+instance Bifunctor Or where
+  bimapM f _ (L a) = L <$> f a
+  bimapM _ g (R a) = R <$> g a
+  bimapM f g (LR a b) = LR <$> f a <*> g b
+
+instance Bifoldable Or where
+  bilistM f _ (L a) = f a |>> return
+  bilistM _ g (R b) = g b |>> return
+  bilistM f g (LR a b) = do
+    c1 <- f a
+    c2 <- g b
+    return [c1, c2]
+
+
+----- Special class instances
+
+instance FromJSON Config where
+  parseJSON =
+    withObject "object" $ \o ->
+      Config
+        <$> o .:? "home" .!= "$HOME/.morloc"
+        <*> o .:? "source" .!= "$HOME/.morloc/src/morloc"
+        <*> o .:? "plain" .!= "morloclib"
+        <*> o .:? "tmpdir" .!= "$HOME/.morloc/tmp"
+        <*> o .:? "lang_python3" .!= "python3"
+        <*> o .:? "lang_R" .!= "Rscript"
+        <*> o .:? "lang_perl" .!= "perl"
+
+instance FromJSON PackageMeta where
+  parseJSON = withObject "object" $ \o ->
+    PackageMeta <$> o .:? "name"        .!= ""
+                <*> o .:? "version"     .!= ""
+                <*> o .:? "homepage"    .!= ""
+                <*> o .:? "synopsis"    .!= ""
+                <*> o .:? "description" .!= ""
+                <*> o .:? "category"    .!= ""
+                <*> o .:? "license"     .!= ""
+                <*> o .:? "author"      .!= ""
+                <*> o .:? "maintainer"  .!= ""
+                <*> o .:? "github"      .!= ""
+                <*> o .:? "bug-reports" .!= ""
+                <*> o .:? "gcc-flags"   .!= ""
+
+instance Defaultable PackageMeta where
+  defaultValue = PackageMeta
+    { packageName = ""
+    , packageVersion = ""
+    , packageHomepage = ""
+    , packageSynopsis = ""
+    , packageDescription = ""
+    , packageCategory = ""
+    , packageLicense = ""
+    , packageAuthor = ""
+    , packageMaintainer = ""
+    , packageGithub = ""
+    , packageBugReports = ""
+    , packageGccFlags = ""
+    }
+
+instance Defaultable MorlocState where
+  defaultValue = MorlocState {
+      statePackageMeta = []
+    , stateVerbosity = 0
+    , stateCounter = -1
+    , stateDepth = 0
+    , stateSignatures = GMap Map.empty Map.empty
+    , stateConcreteTypedefs = GMap Map.empty Map.empty
+    , stateGeneralTypedefs = GMap Map.empty Map.empty
+    , stateUniversalConcreteTypedefs = Map.empty
+    , stateUniversalGeneralTypedefs = Map.empty
+    , stateInnerMogrifiers = GMap Map.empty Map.empty
+    , stateUniversalInnerMogrifiers = Map.empty
+    , stateSources = GMap Map.empty Map.empty
+    , stateAnnotations = Map.empty
+    , stateOutfile = Nothing
+    , stateExports = []
+    , stateName = Map.empty
+  }
+
+instance Annotated IndexedGeneral where
+  val (Idx _ x) = x
+  ann (Idx i _) = i
+  annotate i x = Idx i x
+
+instance HasOneLanguage Source where
+  langOf s = Just (srcLang s)
+  langOf' s = srcLang s
 
 instance Typelike Type where
   typeOf = id
@@ -848,7 +845,7 @@ instance Typelike Type where
   free (AppT t ts) = Set.unions (map free (t:ts))
   free (NamT _ _ _ es) = Set.unions (map (free . snd) es)
 
-  normalizeType (FunT ts1 (FunT ts2 ft)) = normalizeType $ FunT (ts1 <> ts2) ft 
+  normalizeType (FunT ts1 (FunT ts2 ft)) = normalizeType $ FunT (ts1 <> ts2) ft
   normalizeType (AppT t ts) = AppT (normalizeType t) (map normalizeType ts)
   normalizeType (NamT n v ds ks) = NamT n v (map normalizeType ds) (zip (map fst ks) (map (normalizeType . snd) ks))
   normalizeType t = t
@@ -859,7 +856,7 @@ instance Typelike TypeU where
   --  * all qualified terms are replaced with UnkT
   --  * all existentials are replaced with default values if a possible
   typeOf (VarU v) = VarT v
-  typeOf (ExistU _ ps rs@(_:_)) = NamT NamRecord (TV "Record") (map typeOf ps) (map (second typeOf) rs) where
+  typeOf (ExistU _ ps rs@(_:_)) = NamT NamRecord (TV "Record") (map typeOf ps) (map (second typeOf) rs)
   typeOf (ExistU v _ _) = typeOf (ForallU v (VarU v)) -- this will cause problems eventually
   typeOf (ForallU v t) = substituteTVar v (UnkT v) (typeOf t)
   typeOf (FunU ts t) = FunT (map typeOf ts) (typeOf t)
@@ -874,9 +871,9 @@ instance Typelike TypeU where
   free (FunU ts t) = Set.unions $ map free (t:ts)
   free (AppU t ts) = Set.unions $ map free (t:ts)
   free (NamU _ _ ps rs) = Set.unions $ map free (map snd rs <> ps)
-  
 
-  substituteTVar v (ForallU q r) t = 
+
+  substituteTVar v (ForallU q r) t =
     if Set.member (VarU q) (free t)
     then
       let q' = newVariable r t -- get unused variable name from [a, ..., z, aa, ...]
@@ -905,16 +902,531 @@ instance Typelike TypeU where
   normalizeType (ExistU v (map normalizeType -> ps) (map (second normalizeType) -> rs)) = ExistU v ps rs
   normalizeType t = t
 
+
+----- Partial order logic
+
+-- Types are partially ordered, 'forall a . a' is lower (more generic) than
+-- Int. But 'forall a . a -> a' cannot be compared to 'forall a . a', since
+-- they are different kinds.
+-- The order of types is used to choose the most specific serialization functions.
+-- As far as serialization is concerned, properties and constraints do not matter.
+instance P.PartialOrd TypeU where
+  (<=) (VarU v1) (VarU v2) = v1 == v2
+  (<=) (ExistU v1 ts1 rs1) (ExistU v2 ts2 rs2)
+    =  v1 == v2
+    && length ts1 == length ts2
+    && and (zipWith (P.<=) ts1 ts2)
+    && and [maybe False (t1 P.<=) (lookup k rs2) | (k, t1) <- rs1]
+  (<=) (ForallU v t1) t2
+    | (P.==) (ForallU v t1) t2 = True
+    | otherwise = (P.<=) (substituteFirst v t1 t2) t2
+  (<=) (FunU (t11:rs1) t12) (FunU (t21:rs2) t22) = t11 P.<= t21 && FunU rs1 t12 P.<= FunU rs2 t22
+  (<=) (FunU [] t12) (FunU [] t22) = t12 P.<= t22
+  (<=) (AppU t1 (t11:rs1)) (AppU t2 (t21:rs2)) = t11 P.<= t21 && AppU t1 rs1 P.<= AppU t2 rs2
+  (<=) (AppU t1 []) (AppU t2 []) = t1 P.<= t2
+  -- the records do not need to be in the same order to be equivalent
+  -- ---- do I need to sort on ps1/ps2 as well?
+  (<=) (NamU o1 n1 ps1 ((k1,e1):rs1)) (NamU o2 n2 ps2 es2)
+    = case DL.partition ((== k1) . fst) es2 of
+       ([(_,e2)], rs2) -> e1 P.<= e2 && NamU o1 n1 ps1 rs1 P.<= NamU o2 n2 ps2 rs2
+       _ -> False
+  (<=) (NamU o1 n1 ps1 []) (NamU o2 n2 ps2 [])
+    = o1 == o2 && n1 == n2 && length ps1 == length ps2
+  (<=) _ _ = False
+
+  (==) (ForallU v1 t1) (ForallU v2 t2) =
+    if Set.member (VarU v1) (free t2)
+    then
+      let v = newVariable t1 t2
+      in (P.==) (substituteTVar v1 (VarU v) t1) (substituteTVar v2 (VarU v) t2)
+    else (P.==) t1 (substituteTVar v2 (VarU v1) t2)
+  (==) a b = a == b
+
+-- Substitute all v for the first term in t2 that corresponds to v in t1. If v
+-- does not occur in t1, then t1 is returned unchanged (e.g., `forall a . Int`).
+substituteFirst :: TVar -> TypeU -> TypeU -> TypeU
+substituteFirst v t1 t2 = case findFirst v t1 t2 of
+  (Just t) -> substituteTVar v t t1
+  Nothing -> t1
+
+findFirst :: TVar -> TypeU -> TypeU -> Maybe TypeU
+findFirst v = f where
+  f (VarU v') t2
+    | v == v' = Just t2
+    | otherwise = Nothing
+  f (ForallU v1 t1) (ForallU v2 t2)
+    | v == v1 = Nothing
+    | otherwise = f t1 (substituteTVar v2 (VarU v1) t2)
+  f (ForallU v1 t1) t2
+    | v == v1 = Nothing
+    | otherwise = f (substituteTVar v1 (VarU v1) t1) t2
+  f (FunU ts1 t1) (FunU ts2 t2)
+    = foldl firstOf Nothing (zipWith f (ts1 <> [t1]) (ts2 <> [t2]))
+  f (AppU t1 ts1) (AppU t2 ts2)
+    = foldl firstOf Nothing (zipWith f (t1:ts1) (t2:ts2))
+  f (NamU o1 n1 ps1 ((k1,e1):rs1)) (NamU o2 n2 ps2 es2)
+    = case DL.partition ((== k1) . fst) es2 of
+       ([(_,e2)], rs2) -> firstOf (f e1 e2) (f (NamU o1 n1 ps1 rs1) (NamU o2 n2 ps2 rs2))
+       _ -> Nothing
+  f _ _ = Nothing
+
+  firstOf :: Maybe a -> Maybe a -> Maybe a
+  firstOf (Just x) _ = Just x
+  firstOf _ (Just x) = Just x
+  firstOf _ _ = Nothing
+
+-- | is t1 a generalization of t2?
+isSubtypeOf :: TypeU -> TypeU -> Bool
+isSubtypeOf t1 t2 = case P.compare t1 t2 of
+  (Just x) -> x <= EQ
+  _ -> False
+
+equivalent :: TypeU -> TypeU -> Bool
+equivalent t1 t2 = isSubtypeOf t1 t2 && isSubtypeOf t2 t1
+
+-- | find all types that are not greater than any other type
+mostGeneral :: [TypeU] -> [TypeU]
+mostGeneral = P.minima
+
+-- | find all types that are not less than any other type
+mostSpecific :: [TypeU] -> [TypeU]
+mostSpecific = P.maxima
+
+-- | find the most specific subtypes
+mostSpecificSubtypes :: TypeU -> [TypeU] -> [TypeU]
+mostSpecificSubtypes t ts = mostSpecific $ filter (`isSubtypeOf` t) ts
+
+
+----- Pretty instances -------------------------------------------------------
+
+instance (Pretty a, Pretty b) => Pretty (Or a b) where
+  pretty (L x) = parens ("L" <+> pretty x)
+  pretty (R x) = parens ("R" <+> pretty x)
+  pretty (LR x y) = parens ("LR" <+> pretty x <> "," <+> pretty y)
+
+instance Pretty NamType where
+  pretty = viaShow
+
+instance Pretty Type where
+  pretty (UnkT v) = pretty v
+  pretty (VarT v) = pretty v
+  pretty (FunT [] t) = "() -> " <> pretty t
+  pretty (FunT ts t) = encloseSep "(" ")" " -> " (map pretty (ts <> [t]))
+  pretty (AppT t ts) = hsep (map pretty (t:ts))
+  pretty (NamT o n ps rs)
+    = block 4 (viaShow o <+> pretty n <> encloseSep "<" ">" "," (map pretty ps))
+              (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
+
+instance Pretty TypeU where
+  pretty (FunU [] t) = "() -> " <> prettyTypeU t
+  pretty (FunU ts t) = hsep $ punctuate " ->" (map prettyTypeU (ts <> [t]))
+  pretty (ForallU _ t) = pretty t
+  pretty t = prettyTypeU t
+
+prettyTypeU :: TypeU -> Doc ann
+prettyTypeU (ExistU v [] []) = angles $ pretty v
+prettyTypeU (ExistU v ts rs)
+  = angles $ pretty v
+  <+> list (map prettyTypeU ts)
+  <+> list (map ((\(x,y) -> tupled [x, y]) . bimap pretty prettyTypeU) rs)
+prettyTypeU (ForallU _ t) = prettyTypeU t
+prettyTypeU (VarU v) = pretty v
+prettyTypeU (FunU [] t) = parens $ "() -> " <> prettyTypeU t
+prettyTypeU (FunU ts t) = encloseSep "(" ")" " -> " (map prettyTypeU (ts <> [t]))
+prettyTypeU (AppU t ts) = hsep $ map parenTypeU (t:ts) where
+    parenTypeU t'@(AppU _ _) = parens $ prettyTypeU t'
+    parenTypeU t' = prettyTypeU t'
+prettyTypeU (NamU o n ps rs)
+    = parens
+    $ block 4 (viaShow o <+> pretty n <> encloseSep "<" ">" "," (map pretty ps))
+              (vsep [pretty k <+> "::" <+> prettyTypeU x | (k, x) <- rs])
+
+instance Pretty EType where
+  pretty (EType t (Set.toList -> ps) (Set.toList -> cs)) = case (ps, cs) of
+    ([], []) -> pretty t
+    _ -> parens (psStr ps <> pretty t <> csStr cs)
+    where
+      psStr [] = ""
+      psStr [x] = pretty x <+> "=> "
+      psStr xs = tupled (map pretty xs) <+> "=> "
+
+      csStr [] = ""
+      csStr xs = " |" <+> hsep (punctuate semi (map pretty xs))
+
+instance Pretty Property where
+  pretty Pack = "pack"
+  pretty Unpack = "unpack"
+  pretty Cast = "cast"
+  pretty (GeneralProperty ts) = hsep (map pretty ts)
+
+instance Pretty Constraint where
+  pretty (Con x) = pretty x
+
+instance Pretty EVar where
+  pretty (EV v) = pretty v
+
+instance Pretty MVar where
+  pretty = pretty . unMVar
+
+
+instance Pretty TVar where
+  pretty (TV v) = pretty v
+
+instance Pretty Typeclass where
+  pretty = pretty . unTypeclass
+
+instance Pretty Key where
+  pretty (Key v) = pretty v
+
+instance Pretty CVar where
+  pretty v = pretty (unCVar v)
+
+instance Pretty Label where
+  pretty (Label v) = pretty v
+
+instance Pretty SrcName where
+  pretty = pretty . unSrcName
+
+instance Pretty Code where
+  pretty = pretty . unCode
+
+instance Pretty Source where
+  pretty s
+    = "source" <+> pretty (srcLang s)
+    <> maybe "" (\ path -> " from" <+> dquotes (pretty path)) (srcPath s)
+    <+> dquotes (pretty (srcName s))
+    <+> "as" <+> pretty (srcAlias s) <> maybe "" (\t -> ":" <> pretty t) (srcLabel s)
+
+instance Pretty Symbol where
+  pretty (TypeSymbol x) = viaShow x
+  pretty (TermSymbol x) = viaShow x
+
+instance Pretty TermTypes where
+  pretty (TermTypes (Just t) cs es) = "TermTypes" <+> (align . vsep $ (parens (pretty t) : map pretty cs <> map pretty es))
+  pretty (TermTypes Nothing cs es) = "TermTypes" <+> "?" <> (align . vsep $ (map pretty cs <> map pretty es))
+
+instance Pretty SignatureSet where
+  pretty (Monomorphic t) = pretty t
+  pretty (Polymorphic cls v t ts)
+    = "class" <+> pretty cls
+    <+> (align . vsep $ (pretty v <+> "::" <+> parens (pretty t)) : map pretty ts)
+
+instance (Pretty k1, Pretty k2, Pretty v) => Pretty (GMap k1 k2 v) where
+  pretty (GMap m1 m2) = "GMap" <+> (align . vsep $ [pretty (Map.toList m1), pretty (Map.toList m2)])
+
+instance Pretty AliasedSymbol where
+  pretty (AliasedType x alias)
+    | x == alias = pretty x
+    | otherwise = pretty x <+> "as" <+> pretty alias
+  pretty (AliasedTerm x alias)
+    | x == alias = pretty x
+    | otherwise = pretty x <+> "as" <+> pretty alias
+
+instance Pretty None where
+  pretty None = "()"
+
+instance Pretty a => Pretty (One a) where
+  pretty (One x) = pretty x
+
+instance Pretty a => Pretty (Many a) where
+  pretty (Many xs) = list $ map pretty xs
+
+instance Pretty (AnnoS g f c) where
+  pretty (AnnoS _ _ e) = pretty e
+
+instance Pretty (ExprS g f c) where
+  pretty UniS = "UniS"
+  pretty (BndS v) = pretty v
+  pretty (VarS v _) = pretty v
+  pretty (AccS k e) = parens (pretty e) <> "[" <> pretty k <> "]"
+  pretty (AppS e es) = pretty e <> vsep (map pretty es)
+  pretty (LamS vs e) = parens ("\\" <+> hsep (map pretty vs) <+> "->" <+> pretty e)
+  pretty (LstS es) = list (map pretty es)
+  pretty (TupS es) = tupled (map pretty es)
+  pretty (NamS rs) = encloseSep "{" "}" "," [pretty k <+> "=" <+> pretty v | (k,v) <- rs]
+  pretty (RealS x) = viaShow x
+  pretty (IntS x) = pretty x
+  pretty (LogS x) = pretty x
+  pretty (StrS x) = pretty x
+  pretty (CallS src) = pretty src
+
+instance (Pretty k, Pretty a) => Pretty (IndexedGeneral k a) where
+  pretty (Idx i x) = parens (pretty i <> ":" <+> pretty x)
+
+instance Pretty GammaIndex where
+  pretty (VarG tv) = "VarG:" <+> pretty tv
+  pretty (ExistG tv [] []) = angles (pretty tv)
+  pretty (ExistG tv ts rs)
+    = "ExistG:"
+    <+> pretty tv
+    <+> list (map (parens . pretty) ts)
+    <+> list (map ((\(x,y) -> tupled [x, y]) . bimap pretty prettyTypeU) rs)
+  pretty (SolvedG tv t) = "SolvedG:" <+> pretty tv <+> "=" <+> pretty t
+  pretty (MarkG tv) = "MarkG:" <+> pretty tv
+  pretty (SrcG (Source ev1 lang _ _ _)) = "SrcG:" <+> pretty ev1 <+> viaShow lang
+  pretty (AnnG v t) = pretty v <+> "::" <+> pretty t
+
+instance Pretty ExprI where
+  pretty (ExprI i e) = parens (pretty e) <> ":" <> pretty i
+
+instance Pretty Expr where
+  pretty UniE = "()"
+  pretty (ModE v es) = align . vsep $ ("module" <+> pretty v) : map pretty es
+  pretty (ClsE cls vs sigs) = "class" <+> pretty cls <+> hsep (map pretty vs) <> (align . vsep . map pretty) sigs
+  pretty (IstE cls ts es) = "instance" <+> pretty cls <+> hsep (map (parens . pretty) ts) <> (align . vsep . map pretty) es
+  pretty (TypE lang v vs t)
+    = "type" <+> pretty lang <> "@" <> pretty v
+    <+> sep (map pretty vs) <+> "=" <+> pretty t
+  pretty (ImpE (Import m Nothing _ _)) = "import" <+> pretty m
+  pretty (ImpE (Import m (Just xs) _ _)) = "import" <+> pretty m <+> tupled (map pretty xs)
+  pretty (ExpE v) = "export" <+> pretty v
+  pretty (VarE s) = pretty s
+  pretty (AccE k e) = parens (pretty e) <> "@" <> pretty k
+  pretty (LamE v e) = "\\" <+> pretty v <+> "->" <+> pretty e
+  pretty (AnnE e ts) = parens
+    $   pretty e
+    <+> "::"
+    <+> encloseSep "(" ")" "; " (map pretty ts)
+  pretty (LstE es) = encloseSep "[" "]" "," (map pretty es)
+  pretty (TupE es) = encloseSep "[" "]" "," (map pretty es)
+  pretty (AppE f es) = vsep (map pretty (f:es))
+  pretty (NamE rs) = block 4 "<RECORD>" (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
+  pretty (RealE x) = pretty (show x)
+  pretty (IntE x) = pretty (show x)
+  pretty (StrE x) = dquotes (pretty x)
+  pretty (LogE x) = pretty x
+  pretty (AssE v e es) = pretty v <+> "=" <+> pretty e <+> "where" <+> (align . vsep . map pretty) es
+  pretty (SrcE (Source srcname lang file' alias label))
+    = "source"
+    <+> viaShow lang
+    <> maybe "" (\f -> "from" <+> pretty f) file'
+    <+> "("
+    <> dquotes (pretty srcname) <+> "as" <+>  pretty alias <> maybe "" (\s -> ":" <> pretty s) label
+    <> ")"
+  pretty (SigE (Signature v _ e)) =
+    pretty v <+> "::" <+> eprop' <> etype' <> econs'
+    where
+      eprop' :: Doc ann
+      eprop' =
+        case Set.toList (eprop e) of
+          [] -> ""
+          xs -> tupled (map pretty xs) <+> "=> "
+      etype' :: Doc ann
+      etype' = pretty (etype e)
+      econs' :: Doc ann
+      econs' =
+        case Set.toList (econs e) of
+          [] -> ""
+          xs -> " where" <+> tupled (map (\(Con x) -> pretty x) xs)
+
+instance Pretty Signature where
+  pretty (Signature v _ e) = pretty v <+> "::" <+> pretty (etype e)
+
+instance Show MorlocError where
+  show = DT.unpack . render . pretty
+
+instance Show TypeError where
+  show = DT.unpack . render . pretty
+
+instance Pretty MorlocError where
+  pretty (IndexedError i e) = "At index" <+> pretty i <> ":" <+> pretty e
+  pretty (NotImplemented msg) = "Not yet implemented: " <> pretty msg
+  pretty (NotSupported msg) = "NotSupported: " <> pretty msg
+  pretty (UnknownLanguage lang) =
+    "'" <> pretty lang <> "' is not recognized as a supported language"
+  pretty (SyntaxError err') = "SyntaxError: " <> pretty (errorBundlePretty err')
+  pretty (SerializationError t) = "SerializationError: " <> pretty t
+  pretty (CannotLoadModule t) = "CannotLoadModule: " <> pretty t
+  pretty (SystemCallError cmd loc msg) =
+    "System call failed at (" <>
+    pretty loc <> "):\n" <> " cmd> " <> pretty cmd <> "\n" <> " msg>\n" <> pretty msg
+  pretty (PoolBuildError msg) = "PoolBuildError: " <> pretty msg
+  pretty (SelfRecursiveTypeAlias v) = "SelfRecursiveTypeAlias: " <> pretty v
+  pretty (MutuallyRecursiveTypeAlias vs) = "MutuallyRecursiveTypeAlias: " <> tupled (map pretty vs)
+  pretty (BadTypeAliasParameters v exp' obs)
+    =  "BadTypeAliasParameters: for type alias " <> pretty v
+    <> " expected " <> pretty exp'
+    <> " parameters but found " <> pretty obs
+  pretty (ConflictingTypeAliases t1 t2)
+    = "ConflictingTypeAliases:"
+    <> "\n  t1:" <+> pretty t1
+    <> "\n  t2:" <+> pretty t2
+  pretty (CallTheMonkeys msg) =
+    "There is a bug in the code, send this message to the maintainer: " <> pretty msg
+  pretty (GeneratorError msg) = "GeneratorError: " <> pretty msg
+  pretty (ConcreteTypeError err') = "Concrete type error: " <> pretty err'
+  pretty (GeneralTypeError err') = "General type error: " <> pretty err'
+  pretty ToplevelRedefinition = "ToplevelRedefinition"
+  pretty (OtherError msg) = "OtherError: " <> pretty msg
+  -- TODO: this will be a common class of errors and needs an informative message
+  pretty (IncompatibleGeneralType a b)
+    = "Incompatible general types:" <+> parens (pretty a) <+> "vs" <+> parens (pretty b)
+  -- container errors
+  pretty EmptyTuple = "EmptyTuple"
+  pretty TupleSingleton = "TupleSingleton"
+  pretty EmptyRecord = "EmptyRecord"
+  -- module errors
+  pretty (MultipleModuleDeclarations mv) = "MultipleModuleDeclarations: " <> tupled (map pretty mv)
+  pretty (NestedModule name') = "Nested modules are currently illegal: " <> pretty name'
+  pretty (NonSingularRoot ms) = "Expected exactly one root module, found" <+> list (map pretty ms)
+  pretty (ImportExportError (MV m) msg) = "Error in module '" <> pretty m <> "': "  <> pretty msg
+  pretty (CannotFindModule name') = "Cannot find morloc module '" <> pretty name' <> "'"
+  pretty CyclicDependency = "CyclicDependency"
+  pretty (SelfImport _) = "SelfImport"
+  pretty BadRealization = "BadRealization"
+  pretty MissingSource = "MissingSource"
+  -- serialization errors
+  pretty (CyclicPacker t1 t2)
+    = "Error CyclicPacker - a term is described as both a packer and an unpacker:\n  "
+    <> pretty t1 <> "\n  " <> pretty t2
+  -- type extension errors
+  pretty (ConflictingPackers t1 t2)
+    = "Error ConflictingPackers:"
+    <> "\n  t1:" <+> pretty t1
+    <> "\n  t2:" <+> pretty t2
+  pretty (UndefinedType v)
+    =  "UndefinedType: could not resolve type" <+> squotes (pretty v)
+    <> ". You may be missing a language-specific type definition."
+  pretty (AmbiguousPacker _) = "AmbiguousPacker"
+  pretty (AmbiguousUnpacker _) = "AmbiguousUnpacker"
+  pretty (AmbiguousCast _ _) = "AmbiguousCast"
+  pretty (IllegalPacker t) = "IllegalPacker:" <+> pretty t
+  pretty (IncompatibleRealization _) = "IncompatibleRealization"
+  pretty MissingAbstractType = "MissingAbstractType"
+  pretty ExpectedAbstractType = "ExpectedAbstractType"
+  pretty CannotInferConcretePrimitiveType = "CannotInferConcretePrimitiveType"
+  pretty ToplevelStatementsHaveNoLanguage = "ToplevelStatementsHaveNoLanguage"
+  pretty InconsistentWithinTypeLanguage = "InconsistentWithinTypeLanguage"
+  pretty CannotInferLanguageOfEmptyRecord = "CannotInferLanguageOfEmptyRecord"
+  pretty ConflictingSignatures = "ConflictingSignatures: currently a given term can have only one type per language"
+  pretty CompositionsMustBeGeneral = "CompositionsMustBeGeneral"
+  pretty IllegalConcreteAnnotation = "IllegalConcreteAnnotation"
+  pretty (DagMissingKey msg) = "DagMissingKey: " <> pretty msg
+  pretty TooManyRealizations = "TooManyRealizations"
+  pretty (CannotSynthesizeConcreteType m src t [])
+    = "Cannot synthesize" <+> pretty (srcLang src) <+>
+      "type for" <+> squotes (pretty (srcAlias src)) <+>
+      "in module" <+> pretty m <+>
+      "from general type:" <+> parens (pretty t)
+  pretty (CannotSynthesizeConcreteType m src t vs)
+    = pretty (CannotSynthesizeConcreteType m src t []) <> "\n" <>
+      "  Cannot resolve concrete types for these general types:" <+> list (map pretty vs) <> "\n" <>
+      "  Are you missing type alias imports?"
+
+instance Pretty TypeError where
+  pretty (SubtypeError t1 t2 msg)
+    = "SubtypeError:" <+> pretty msg <> "\n  "
+    <> "(" <> pretty t1 <+> "<:" <+> pretty t2 <> ")"
+  pretty (InstantiationError t1 t2 msg)
+    = "InstantiationError:" <+> "(" <> pretty t1 <+> "<:=" <+> pretty t2 <> ")" <> "\n"
+    <> "   " <> align (pretty msg)
+  pretty (EmptyCut gi) = "EmptyCut:" <+> pretty gi
+  pretty OccursCheckFail {} = "OccursCheckFail"
+  pretty (Mismatch t1 t2 msg)
+    = "Mismatch"
+    <+> tupled ["t1=" <> pretty t1, "t2=" <> pretty t2]
+    <+> pretty msg
+  pretty (UnboundVariable v) = "UnboundVariable:" <+> pretty v
+  pretty (KeyError k t) = "KeyError:" <+> dquotes (pretty k) <+> "not found in record:" <+> pretty t
+  pretty (MissingConcreteSignature e lang) = "No concrete signature found for" <+> pretty lang <+> "function named" <+> squotes (pretty e)
+  pretty (MissingGeneralSignature e) = "MissingGeneralSignature for" <+> squotes (pretty e)
+  pretty ApplicationOfNonFunction = "ApplicationOfNonFunction"
+  pretty TooManyArguments = "TooManyArguments"
+  pretty (MissingFeature msg) = "MissingFeature: " <> pretty msg
+  pretty (EmptyExpression e) = "EmptyExpression:" <+> squotes (pretty e) <+> "has no bound signature or expression"
+  pretty InfiniteRecursion = "InfiniteRecursion"
+  pretty (FunctionSerialization v) = "Undefined function" <+> dquotes (pretty v) <> ", did you forget an import?"
+
+
+
+
+------- Helper functions
+
+mapExprSM :: (Traversable f, Monad m) => (AnnoS g f c -> m (AnnoS g' f c')) -> ExprS g f c -> m (ExprS g' f c')
+mapExprSM f (VarS v xs) = VarS v <$> traverse f xs
+mapExprSM f (AccS k x) = AccS k <$> f x
+mapExprSM f (AppS x xs) = AppS <$> f x <*> mapM f xs
+mapExprSM f (LamS vs x) = LamS vs <$> f x
+mapExprSM f (LstS xs) = LstS <$> mapM f xs
+mapExprSM f (TupS xs) = TupS <$> mapM f xs
+mapExprSM f (NamS rs) = NamS <$> mapM (secondM f) rs
+mapExprSM _ UniS = return UniS
+mapExprSM _ (BndS v) = return $ BndS v
+mapExprSM _ (RealS x) = return $ RealS x
+mapExprSM _ (IntS x) = return $ IntS x
+mapExprSM _ (LogS x) = return $ LogS x
+mapExprSM _ (StrS x) = return $ StrS x
+mapExprSM _ (CallS x) = return $ CallS x
+
+mapAnnoSM :: (Traversable f, Monad m) => (ExprS g f c -> g -> c -> m (g', c')) -> AnnoS g f c -> m (AnnoS g' f c')
+mapAnnoSM fun (AnnoS g c e) = do
+  e' <- mapExprSM (mapAnnoSM fun) e
+  (g', c') <- fun e g c
+  return (AnnoS g' c' e')
+
+mapAnnoS :: (Traversable f) => (ExprS g f c -> g -> c -> (g', c')) -> AnnoS g f c -> AnnoS g' f c'
+mapAnnoS fun = runIdentity . mapAnnoSM (\x g c -> return (fun x g c))
+
+mapExprS :: (Traversable f) => (AnnoS g f c -> AnnoS g' f c') -> ExprS g f c -> ExprS g' f c'
+mapExprS fun = runIdentity . mapExprSM (return . fun)
+
+mapAnnoSGM :: (Traversable f, Monad m) => (g -> m g') -> AnnoS g f c -> m (AnnoS g' f c)
+mapAnnoSGM f = mapAnnoSM (\_ gi ci -> (,) <$> f gi <*> pure ci)
+
+mapAnnoSCM :: (Traversable f, Monad m) => (c -> m c') -> AnnoS g f c -> m (AnnoS g f c')
+mapAnnoSCM f = mapAnnoSM (\_ gi ci -> (,) gi <$> f ci)
+
+mapAnnoSG :: (Traversable f) => (g -> g') -> AnnoS g f c -> AnnoS g' f c
+mapAnnoSG f = mapAnnoS (\_ gi ci -> (f gi, ci))
+
+mapAnnoSC :: (Traversable f) => (c -> c') -> AnnoS g f c -> AnnoS g f c'
+mapAnnoSC f = mapAnnoS (\_ gi ci -> (gi, f ci))
+
+mapExprSGM :: (Traversable f, Monad m) => (g -> m g') -> ExprS g f c -> m (ExprS g' f c)
+mapExprSGM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS <$> f gi <*> pure ci <*> mapExprSGM f e)
+
+mapExprSCM :: (Traversable f, Monad m) => (c -> m c') -> ExprS g f c -> m (ExprS g f c')
+mapExprSCM f = mapExprSM (\(AnnoS gi ci e) -> AnnoS gi <$> f ci <*> mapExprSCM f e)
+
+mapExprSG :: (Traversable f) => (g -> g') -> ExprS g f c -> ExprS g' f c
+mapExprSG f = mapExprS (\(AnnoS gi ci e) -> AnnoS (f gi) ci (mapExprSG f e))
+
+mapExprSC :: (Traversable f) => (c -> c') -> ExprS g f c -> ExprS g f c'
+mapExprSC f = mapExprS (\(AnnoS gi ci e) -> AnnoS gi (f ci) (mapExprSC f e))
+
+extractKey :: TypeU -> TVar
+extractKey (VarU v) = v
+extractKey (ForallU _ t) = extractKey t
+extractKey (AppU t _) = extractKey t
+extractKey (NamU _ v _ _) = v
+extractKey (ExistU v _ _) = v
+extractKey t = error $ "Cannot currently handle functional type imports: " <> show t
+
+type2typeu :: Type -> TypeU
+type2typeu (VarT v) = VarU v
+type2typeu (UnkT v) = ForallU v (VarU v) -- sus
+type2typeu (FunT ts t) = FunU (map type2typeu ts) (type2typeu t)
+type2typeu (AppT v ts) = AppU (type2typeu v) (map type2typeu ts)
+type2typeu (NamT o n ps rs) = NamU o n (map type2typeu ps) [(k, type2typeu x) | (k,x) <- rs]
+
+unresolvedType2type :: TypeU -> Type
+unresolvedType2type (VarU v) = VarT v
+unresolvedType2type ExistU {} = error "Cannot cast existential type to Type"
+unresolvedType2type (ForallU _ _) = error "Cannot cast universal type as Type"
+unresolvedType2type (FunU ts t) = FunT (map unresolvedType2type ts) (unresolvedType2type t)
+unresolvedType2type (AppU v ts) = AppT (unresolvedType2type v) (map unresolvedType2type ts)
+unresolvedType2type (NamU t n ps rs) = NamT t n (map unresolvedType2type ps) [(k, unresolvedType2type e) | (k, e) <- rs]
+
 -- | get a fresh variable name that is not used in t1 or t2, it reside in the same namespace as the first type
-newVariable :: TypeU -> TypeU -> TVar 
+newVariable :: TypeU -> TypeU -> TVar
 newVariable t1 t2 = findNew variables (Set.union (allVars t1) (allVars t2))
-  where 
+  where
     variables = [1 ..] >>= flip replicateM ['a' .. 'z']
 
     findNew :: [String] -> Set.Set TypeU -> TVar
     findNew [] _ = error "No variable in the infinite list was OK with you? Sheesh, picky."
     findNew (x:xs) ts
-      | Set.member (VarU v) ts = findNew xs ts 
+      | Set.member (VarU v) ts = findNew xs ts
       | otherwise = v
       where
         v = TV $ DT.pack x
@@ -922,11 +1434,3 @@ newVariable t1 t2 = findNew variables (Set.union (allVars t1) (allVars t2))
     allVars :: TypeU -> Set.Set TypeU
     allVars (ForallU v t) = Set.union (Set.singleton (VarU v)) (allVars t)
     allVars t = free t
-
-
-class HasOneLanguage a where
-  langOf :: a -> Maybe Lang
-  langOf' :: a -> Lang
-
-  langOf x = Just (langOf' x) 
-  langOf' x = fromJust (langOf x)
diff --git a/library/Morloc/Pretty.hs b/library/Morloc/Pretty.hs
deleted file mode 100644
index d593d8ba..00000000
--- a/library/Morloc/Pretty.hs
+++ /dev/null
@@ -1,224 +0,0 @@
-{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
-
-{-|
-Module      : Morloc.Pretty
-Description : Pretty print instances
-Copyright   : (c) Zebulun Arendsee, 2021
-License     : GPL-3
-Maintainer  : zbwrnz@gmail.com
-Stability   : experimental
--}
-module Morloc.Pretty () where
-
-import Morloc.Data.Doc
-import Morloc.Namespace
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-
-instance Pretty Symbol where
-  pretty (TypeSymbol x) = viaShow x
-  pretty (TermSymbol x) = viaShow x
-
-instance Pretty AliasedSymbol where
-  pretty (AliasedType x alias)
-    | x == alias = pretty x
-    | otherwise = pretty x <+> "as" <+> pretty alias
-  pretty (AliasedTerm x alias)
-    | x == alias = pretty x
-    | otherwise = pretty x <+> "as" <+> pretty alias
-
-instance Pretty MVar where
-  pretty = pretty . unMVar
-
-instance Pretty EVar where
-  pretty (EV v) = pretty v
-
-instance Pretty TVar where
-  pretty (TV v) = pretty v
-
-instance Pretty Typeclass where
-  pretty = pretty . unTypeclass
-
-instance (Pretty k1, Pretty k2, Pretty v) => Pretty (GMap k1 k2 v) where
-  pretty (GMap m1 m2) = "GMap" <+> (align . vsep $ [pretty (Map.toList m1), pretty (Map.toList m2)])
-
-instance Pretty SignatureSet where
-  pretty (Monomorphic t) = pretty t
-  pretty (Polymorphic cls v t ts)
-    = "class" <+> pretty cls
-    <+> (align . vsep $ (pretty v <+> "::" <+> parens (pretty t)) : map pretty ts)
-
-instance Pretty TermTypes where
-  pretty (TermTypes (Just t) cs es) = "TermTypes" <+> (align . vsep $ (parens (pretty t) : map pretty cs <> map pretty es))
-  pretty (TermTypes Nothing cs es) = "TermTypes" <+> "?" <> (align . vsep $ (map pretty cs <> map pretty es))
-
-instance Pretty Key where
-  pretty (Key v) = pretty v
-
-instance Pretty Label where
-  pretty (Label v) = pretty v
-
-instance Pretty Code where
-  pretty = pretty . unCode
-
-instance Pretty SrcName where
-  pretty = pretty . unSrcName
-
-instance Pretty Lang where
-  pretty = viaShow
-
-instance Pretty NamType where
-  pretty = viaShow
-
-instance (Pretty a, Pretty b) => Pretty (Or a b) where
-  pretty (L x) = parens ("L" <+> pretty x)
-  pretty (R x) = parens ("R" <+> pretty x)
-  pretty (LR x y) = parens ("LR" <+> pretty x <> "," <+> pretty y)
-
-instance Pretty Source where
-  pretty s
-    = "source" <+> pretty (srcLang s)
-    <> maybe "" (\ path -> " from" <+> dquotes (pretty path)) (srcPath s)
-    <+> dquotes (pretty (srcName s))
-    <+> "as" <+> pretty (srcAlias s) <> maybe "" (\t -> ":" <> pretty t) (srcLabel s)
-
-instance Pretty Type where
-  pretty (UnkT v) = pretty v
-  pretty (VarT v) = pretty v
-  pretty (FunT [] t) = "() -> " <> pretty t
-  pretty (FunT ts t) = encloseSep "(" ")" " -> " (map pretty (ts <> [t]))
-  pretty (AppT t ts) = hsep (map pretty (t:ts))
-  pretty (NamT o n ps rs)
-    = block 4 (viaShow o <+> pretty n <> encloseSep "<" ">" "," (map pretty ps))
-              (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
-
-instance Pretty EType where
-  pretty (EType t (Set.toList -> ps) (Set.toList -> cs)) = case (ps, cs) of
-    ([], []) -> pretty t
-    _ -> parens (psStr ps <> pretty t <> csStr cs)
-    where
-      psStr [] = ""
-      psStr [x] = pretty x <+> "=> "
-      psStr xs = tupled (map pretty xs) <+> "=> "
-
-      csStr [] = ""
-      csStr xs = " |" <+> hsep (punctuate semi (map pretty xs))
-
-instance Pretty Property where
-  pretty Pack = "pack"
-  pretty Unpack = "unpack"
-  pretty Cast = "cast"
-  pretty (GeneralProperty ts) = hsep (map pretty ts)
-
-instance Pretty Constraint where
-  pretty (Con x) = pretty x
-
-instance Pretty TypeU where
-  pretty (FunU [] t) = "() -> " <> prettyTypeU t
-  pretty (FunU ts t) = hsep $ punctuate " ->" (map prettyTypeU (ts <> [t]))
-  pretty (ForallU _ t) = pretty t
-  pretty t = prettyTypeU t
-
-instance Pretty None where
-  pretty None = "()"
-
-instance Pretty a => Pretty (One a) where
-  pretty (One x) = pretty x
-
-instance Pretty a => Pretty (Many a) where
-  pretty (Many xs) = list $ map pretty xs
-
-prettyTypeU (ExistU v [] []) = angles $ pretty v
-prettyTypeU (ExistU v ts rs)
-  = angles $ pretty v
-  <+> list (map prettyTypeU ts)
-  <+> list (map ((\(x,y) -> tupled [x, y]) . bimap pretty prettyTypeU) rs)
-prettyTypeU (ForallU _ t) = prettyTypeU t
-prettyTypeU (VarU v) = pretty v
-prettyTypeU (FunU [] t) = parens $ "() -> " <> prettyTypeU t
-prettyTypeU (FunU ts t) = encloseSep "(" ")" " -> " (map prettyTypeU (ts <> [t]))
-prettyTypeU (AppU t ts) = hsep $ map parenTypeU (t:ts) where
-    parenTypeU t'@(AppU _ _) = parens $ prettyTypeU t'
-    parenTypeU t' = prettyTypeU t'
-prettyTypeU (NamU o n ps rs)
-    = parens
-    $ block 4 (viaShow o <+> pretty n <> encloseSep "<" ">" "," (map pretty ps))
-              (vsep [pretty k <+> "::" <+> prettyTypeU x | (k, x) <- rs])
-
-instance Pretty (AnnoS g f c) where
-  pretty (AnnoS e g c) = "AnnoS"
-
-instance Pretty (ExprS g f c) where
-  pretty _ = "ExprS"
-
-instance (Pretty k, Pretty a) => Pretty (IndexedGeneral k a) where
-  pretty (Idx i x) = parens (pretty i <> ":" <+> pretty x)
-
-instance Pretty GammaIndex where
-  pretty (VarG tv) = "VarG:" <+> pretty tv
-  pretty (ExistG tv [] []) = angles (pretty tv)
-  pretty (ExistG tv ts rs)
-    = "ExistG:"
-    <+> pretty tv
-    <+> list (map (parens . pretty) ts)
-    <+> list (map ((\(x,y) -> tupled [x, y]) . bimap pretty prettyTypeU) rs)
-  pretty (SolvedG tv t) = "SolvedG:" <+> pretty tv <+> "=" <+> pretty t
-  pretty (MarkG tv) = "MarkG:" <+> pretty tv
-  pretty (SrcG (Source ev1 lang _ _ _)) = "SrcG:" <+> pretty ev1 <+> viaShow lang
-  pretty (AnnG v t) = pretty v <+> "::" <+> pretty t
-
-instance Pretty ExprI where
-  pretty (ExprI i e) = parens (pretty e) <> ":" <> pretty i
-
-instance Pretty Expr where
-  pretty UniE = "()"
-  pretty (ModE v es) = align . vsep $ ("module" <+> pretty v) : map pretty es
-  pretty (ClsE cls vs sigs) = "class" <+> pretty cls <+> hsep (map pretty vs) <> (align . vsep . map pretty) sigs
-  pretty (IstE cls ts es) = "instance" <+> pretty cls <+> hsep (map (parens . pretty) ts) <> (align . vsep . map pretty) es
-  pretty (TypE lang v vs t)
-    = "type" <+> pretty lang <> "@" <> pretty v
-    <+> sep (map pretty vs) <+> "=" <+> pretty t
-  pretty (ImpE (Import m Nothing _ _)) = "import" <+> pretty m
-  pretty (ImpE (Import m (Just xs) _ _)) = "import" <+> pretty m <+> tupled (map pretty xs)
-  pretty (ExpE v) = "export" <+> pretty v
-  pretty (VarE s) = pretty s
-  pretty (AccE k e) = parens (pretty e) <> "@" <> pretty k
-  pretty (LamE v e) = "\\" <+> pretty v <+> "->" <+> pretty e
-  pretty (AnnE e ts) = parens
-    $   pretty e
-    <+> "::"
-    <+> encloseSep "(" ")" "; " (map pretty ts)
-  pretty (LstE es) = encloseSep "[" "]" "," (map pretty es)
-  pretty (TupE es) = encloseSep "[" "]" "," (map pretty es)
-  pretty (AppE f es) = vsep (map pretty (f:es))
-  pretty (NamE rs) = block 4 "<RECORD>" (vsep [pretty k <+> "::" <+> pretty x | (k, x) <- rs])
-  pretty (RealE x) = pretty (show x)
-  pretty (IntE x) = pretty (show x)
-  pretty (StrE x) = dquotes (pretty x)
-  pretty (LogE x) = pretty x
-  pretty (AssE v e es) = pretty v <+> "=" <+> pretty e <+> "where" <+> (align . vsep . map pretty) es
-  pretty (SrcE (Source name lang file' alias label))
-    = "source"
-    <+> viaShow lang
-    <> maybe "" (\f -> "from" <+> pretty f) file'
-    <+> "("
-    <> dquotes (pretty name) <+> "as" <+>  pretty alias <> maybe "" (\s -> ":" <> pretty s) label
-    <> ")"
-  pretty (SigE (Signature v _ e)) =
-    pretty v <+> "::" <+> eprop' <> etype' <> econs'
-    where
-      eprop' :: Doc ann
-      eprop' =
-        case Set.toList (eprop e) of
-          [] -> ""
-          xs -> tupled (map pretty xs) <+> "=> "
-      etype' :: Doc ann
-      etype' = pretty (etype e)
-      econs' :: Doc ann
-      econs' =
-        case Set.toList (econs e) of
-          [] -> ""
-          xs -> " where" <+> tupled (map (\(Con x) -> pretty x) xs)
-
-instance Pretty Signature where
-  pretty (Signature v _ e) = pretty v <+> "::" <+> pretty (etype e)
diff --git a/library/Morloc/ProgramBuilder/Build.hs b/library/Morloc/ProgramBuilder/Build.hs
index 481949a5..997efb60 100644
--- a/library/Morloc/ProgramBuilder/Build.hs
+++ b/library/Morloc/ProgramBuilder/Build.hs
@@ -19,12 +19,12 @@ import qualified Morloc.System as MS
 import qualified System.Directory as SD
 
 buildProgram :: (Script, [Script]) -> MorlocMonad ()
-buildProgram (nexus, pools) = mapM_ build (nexus:pools) 
+buildProgram (nexus, pools) = mapM_ build (nexus:pools)
 
 build :: Script -> MorlocMonad ()
 build s = do
   -- write the required file structure
-  liftIO $ MS.writeDirectoryWith (\f c -> MT.writeFile f (unCode c)) (scriptCode s)
+  _ <- liftIO $ MS.writeDirectoryWith (\f c -> MT.writeFile f (unCode c)) (scriptCode s)
   -- execute all make commands
   mapM_ runSysCommand (scriptMake s)
 
diff --git a/library/Morloc/System.hs b/library/Morloc/System.hs
index 03290255..258834f0 100644
--- a/library/Morloc/System.hs
+++ b/library/Morloc/System.hs
@@ -13,7 +13,7 @@ module Morloc.System
   , loadYamlConfig
   ) where
 
-import Morloc.Namespace 
+import Morloc.Namespace
 
 import Data.Aeson (FromJSON(..))
 import qualified Data.Yaml.Config as YC
@@ -23,7 +23,7 @@ import System.Directory.Tree
 
 loadYamlConfig ::
      FromJSON a
-  => Maybe [String] -- ^ possible locations of the config file 
+  => Maybe [String] -- ^ possible locations of the config file
   -> YC.EnvUsage -- ^ default values taken from the environment (or a hashmap)
   -> IO a -- ^ default configuration
   -> IO a
diff --git a/library/Morloc/TypeEval.hs b/library/Morloc/TypeEval.hs
index c965b848..dd408b47 100644
--- a/library/Morloc/TypeEval.hs
+++ b/library/Morloc/TypeEval.hs
@@ -13,7 +13,7 @@ module Morloc.TypeEval (
   evaluateType,
   transformType,
   evaluateStep,
-  pairEval 
+  pairEval
 ) where
 
 import Morloc.Namespace
@@ -21,7 +21,6 @@ import qualified Morloc.Data.Text as MT
 import qualified Morloc.Monad as MM
 import qualified Morloc.Data.Map as Map
 import qualified Data.Set as Set
-import qualified Morloc.Frontend.PartialOrder as MTP
 
 -- Evaluate an expression with both the concrete and general scopes.
 --
@@ -35,7 +34,7 @@ pairEval
 pairEval cscope gscope
   -- transform the concrete type until an unresolvable node is reached
   = generalTransformType Set.empty id resolveGen cscope
-  where 
+  where
     -- resolve by attempting to evaluate one step as in the general scope
     resolveGen f bnd t
       = case generalTransformType bnd (\_ _ -> return) resolveFail gscope t of
@@ -166,7 +165,7 @@ generalTransformType bnd0 recurse' resolve' h = f bnd0
   renameTypedefs bnd (v@(TV x) : vs, t, isTerminal)
     | Set.member v bnd =
         let (vs', t', isTerminal') = renameTypedefs bnd (vs, t, isTerminal)
-            v' = head [x' | x' <- [TV (MT.show' i <> x) | i <- [0..]], not (Set.member x' bnd), x' `notElem` vs']  
+            v' = head [x' | x' <- [TV (MT.show' i <> x) | i <- [(0 :: Int) ..]], not (Set.member x' bnd), x' `notElem` vs']
             t'' = substituteTVar v (VarU v') t'
         in (v':vs', t'', isTerminal')
     | otherwise =
@@ -182,8 +181,8 @@ generalTransformType bnd0 recurse' resolve' h = f bnd0
     -> Either MorlocError ([TVar], TypeU, Bool)
   mergeAliases v i t@(ts1, t1, isTerminal1) (ts2, t2, isTerminal2)
     | i /= length ts1 = MM.throwError $ BadTypeAliasParameters v i (length ts1)
-    |    MTP.isSubtypeOf t1' t2'
-      && MTP.isSubtypeOf t2' t1'
+    |    isSubtypeOf t1' t2'
+      && isSubtypeOf t2' t1'
       && length ts1 == length ts2
       && isTerminal1 == isTerminal2 = return t
     | otherwise = MM.throwError (ConflictingTypeAliases t1 t2)
diff --git a/library/Morloc/Typecheck/Internal.hs b/library/Morloc/Typecheck/Internal.hs
index f81ac915..03e9e9c0 100644
--- a/library/Morloc/Typecheck/Internal.hs
+++ b/library/Morloc/Typecheck/Internal.hs
@@ -54,7 +54,6 @@ module Morloc.Typecheck.Internal
 import Morloc.Namespace
 import qualified Morloc.Data.Text as MT
 import Morloc.Data.Doc
-import Morloc.Pretty ()
 import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Monad as MM
 
@@ -92,7 +91,7 @@ instance Applicable TypeU where
   -- [G]ForallU a.a = forall a. [G]a
   apply g (ForallU v a) =
     -- FIXME: VERY WRONG
-    case lookupU v g of 
+    case lookupU v g of
       (Just _) -> apply g a
       Nothing -> ForallU v (apply g a)
 
@@ -108,12 +107,12 @@ instance Applicable EType where
   apply g e = e { etype = apply g (etype e) }
 
 instance Applicable Gamma where
-  apply g1 g2 = g2 {gammaContext = map f (gammaContext g2)} where 
+  apply g1 g2 = g2 {gammaContext = map f (gammaContext g2)} where
     f :: GammaIndex -> GammaIndex
     f (AnnG v t) = AnnG v (apply g1 t)
     f (ExistG v ps rs) = ExistG v (map (apply g1) ps) (map (second (apply g1)) rs)
     f (SolvedG v t) = SolvedG v (apply g1 t)
-    f x = x 
+    f x = x
 
 class GammaIndexLike a where
   index :: a -> GammaIndex
@@ -150,7 +149,7 @@ subtype t1@(VarU a1) t2@(VarU a2) g
   -- Else, raise an error
   | a1 /= a2 = Left $ Mismatch t1 t2 "Unequal types with no conversion rule"
 
-subtype a@(ExistU l1 _ _) b@(ExistU l2 _ _) g
+subtype a@ExistU{} b@ExistU{} g
   --
   -- ----------------------------------------- <:Exvar
   --  G[E.a] |- E.a <: E.a -| G[E.a]
@@ -166,7 +165,7 @@ subtype a@(ExistU l1 _ _) b@(ExistU l2 _ _) g
 --  g2 |- [g2]A2 <: [g2]B2 -| g3
 -- ----------------------------------------- <:-->
 --  g1 |- A1 -> A2 <: B1 -> B2 -| g3
--- 
+--
 -- function subtypes are *contravariant* with respect to the input, that is,
 -- the subtypes are reversed so we have b1<:a1 instead of a1<:b1.
 subtype (FunU [] a2) (FunU [] b2) g = subtype a2 b2 g
@@ -257,7 +256,7 @@ instantiate :: TypeU -> TypeU -> Gamma -> Either TypeError Gamma
 instantiate ta@(ExistU _ _ (_:_)) tb@(NamU _ _ _ _) g1 = instantiate tb ta g1
 instantiate ta@(NamU _ _ _ rs1) tb@(ExistU v _ rs2@(_:_)) g1 = do
   g2 <- foldM (\g' (t1, t2) -> subtype t1 t2 g') g1 [(t1, t2) | (k1, t1) <- rs1, (k2, t2) <- rs2, k1 == k2]
-  case access1 v (gammaContext g2) of 
+  case access1 v (gammaContext g2) of
     (Just (rhs, _, lhs)) -> do
         solved <- solve v ta
         return $ g2 {gammaContext = rhs ++ [solved] ++ lhs}
@@ -401,7 +400,7 @@ solve v t
         toTVar (ExistU v' _ _) = Just v'
         toTVar (VarU v') = Just v'
         toTVar _ = Nothing
-    
+
 
 
 occursCheck :: TypeU -> TypeU -> MT.Text -> Either TypeError ()
@@ -492,7 +491,7 @@ newvarRich ps rs prefix g =
 
 -- | standardize quantifier names, for example, replace `a -> b` with `v0 -> v1`.
 rename :: Gamma -> TypeU -> (Gamma, TypeU)
-rename g0 (ForallU v@(TV s) t0) = 
+rename g0 (ForallU v@(TV s) t0) =
   let (g1, v') = tvarname g0 (s <> "_q")
       (g2, t1) = rename g1 t0
       t2 = substituteTVar v (VarU v') t1
@@ -574,9 +573,9 @@ leave d = do
 seeGamma :: Gamma -> MorlocMonad ()
 seeGamma g = MM.sayVVV $ nest 4 $ "Gamma:" <> line <> vsep (map pretty (gammaContext g))
 
-peak :: (Pretty c, Pretty g) => ExprS g f c -> MorlocMonad ()
+peak :: ExprS g f c -> MorlocMonad ()
 peak = insetSay . pretty
 
-peakGen :: (Pretty c, Pretty g) => AnnoS g f c -> MorlocMonad ()
+peakGen :: AnnoS g f c -> MorlocMonad ()
 peakGen = insetSay . pretty
 
diff --git a/test-suite/UnitTypeTests.hs b/test-suite/UnitTypeTests.hs
index 4dc71901..d7cd1d4f 100644
--- a/test-suite/UnitTypeTests.hs
+++ b/test-suite/UnitTypeTests.hs
@@ -18,7 +18,6 @@ import Text.RawString.QQ
 import Morloc (typecheckFrontend)
 import Morloc.Frontend.Typecheck (evaluateAnnoSTypes)
 import qualified Morloc.Monad as MM
-import qualified Morloc.Frontend.PartialOrder as MP
 import qualified Morloc.Typecheck.Internal as MTI
 
 import qualified Data.Text as MT
@@ -572,105 +571,105 @@ typeOrderTests =
     "Tests of type partial ordering (subtype)"
     [ testFalse
         "Str !< Real"
-        (MP.isSubtypeOf str real)
+        (isSubtypeOf str real)
     , testFalse
         "Real !< Str"
-        (MP.isSubtypeOf real str)
+        (isSubtypeOf real str)
     , testFalse
         "[Real] !< [Str]"
-        (MP.isSubtypeOf (lst real) (lst str))
+        (isSubtypeOf (lst real) (lst str))
     , testFalse
         "[Str] !< [Real]"
-        (MP.isSubtypeOf (lst str) (lst real))
+        (isSubtypeOf (lst str) (lst real))
     , testFalse
         "Str -> Str -> Str !< Real -> Real -> Real"
-        (MP.isSubtypeOf (fun [str, str, str]) (fun [real, real, real]))
+        (isSubtypeOf (fun [str, str, str]) (fun [real, real, real]))
     , testFalse
         "Real -> Real -> Real !< Str -> Str -> Str"
-        (MP.isSubtypeOf (fun [real, real, real]) (fun [str, str, str]))
+        (isSubtypeOf (fun [real, real, real]) (fun [str, str, str]))
     , testFalse
         "Str -> Str !< Int -> Int -> Int"
-        (MP.isSubtypeOf (fun [str, str]) (fun [int, int, int]))
+        (isSubtypeOf (fun [str, str]) (fun [int, int, int]))
     , testTrue
         "a <: Int"
-        (MP.isSubtypeOf (forall ["a"] (var "a")) int)
+        (isSubtypeOf (forall ["a"] (var "a")) int)
     , testFalse
         "Int !< forall a . a"
-        (MP.isSubtypeOf int (forall ["a"] (var "a")))
+        (isSubtypeOf int (forall ["a"] (var "a")))
     , testTrue
         "forall a . (Int, a) <: (Int, Str)"
-        (MP.isSubtypeOf (forall ["a"] (tuple [int, var "a"])) (tuple [int, str]))
+        (isSubtypeOf (forall ["a"] (tuple [int, var "a"])) (tuple [int, str]))
     , testTrue
         "forall a b . (a, b) <: (Int, Str)"
-        (MP.isSubtypeOf (forall ["a", "b"] (tuple [var "a", var "b"])) (tuple [int, str]))
+        (isSubtypeOf (forall ["a", "b"] (tuple [var "a", var "b"])) (tuple [int, str]))
     , testTrue
         "forall a . (Int, a) <: forall b . (Int, b)"
-        (MP.isSubtypeOf
+        (isSubtypeOf
           (forall ["a"] (tuple [int, var "a"]))
           (forall ["b"] (tuple [int, var "b"])))
     , testTrue
         "forall a . a <: (Int, Str)"
-        (MP.isSubtypeOf (forall ["a"] (var "a")) (tuple [int, str]))
+        (isSubtypeOf (forall ["a"] (var "a")) (tuple [int, str]))
     , testTrue
         "forall a . a <: forall a b . (a, b)"
-        (MP.isSubtypeOf (forall ["a"] (var "a")) (forall ["a", "b"] (tuple [var "a", var "b"])))
+        (isSubtypeOf (forall ["a"] (var "a")) (forall ["a", "b"] (tuple [var "a", var "b"])))
     -- cannot compare
     , testFalse
         "[Int] !< Int"
-        (MP.isSubtypeOf (lst int) int)
+        (isSubtypeOf (lst int) int)
     , testFalse
         "Int !< [Int]"
-        (MP.isSubtypeOf int (lst int))
+        (isSubtypeOf int (lst int))
     -- partial order of types
     , testTrue
         "forall a . [a] <= [Int]"
-        ((forall ["a"] (lst (var "a"))) MP.<= (lst (var "a")))
+        ((forall ["a"] (lst (var "a"))) <= (lst (var "a")))
     , testFalse
         "[Int] !< forall a . [a]"
-        ((lst (var "a")) MP.<= (forall ["a"] (lst (var "a"))))
+        ((lst (var "a")) <= (forall ["a"] (lst (var "a"))))
     , testTrue
         "forall a . (Int, a) <= (Int, Bool)"
-        ((forall ["a"] (tuple [int, var "a"])) MP.<= (tuple [int, bool]))
+        ((forall ["a"] (tuple [int, var "a"])) <= (tuple [int, bool]))
     , testFalse
         "(Int, Bool) !<= forall a . (Int, a)"
-        ((tuple [int, bool]) MP.<= (forall ["a"] (tuple [int, var "a"])))
+        ((tuple [int, bool]) <= (forall ["a"] (tuple [int, var "a"])))
     , testTrue
         "forall a b . (a, b) <= forall c . (Int, c)"
-        ((forall ["a", "b"] (tuple [var "a", var "b"])) MP.<= (forall ["c"] (tuple [int, var "c"])))
+        ((forall ["a", "b"] (tuple [var "a", var "b"])) <= (forall ["c"] (tuple [int, var "c"])))
     , testFalse
         "forall c . (Int, c) !<= forall a b . (a, b)"
-        ((forall ["c"] (tuple [int, var "c"])) MP.<= (forall ["a", "b"] (tuple [var "a", var "b"])))
+        ((forall ["c"] (tuple [int, var "c"])) <= (forall ["a", "b"] (tuple [var "a", var "b"])))
     , testTrue
         "forall a . a <= forall a b . (a, b)"
-        ((forall ["a"] (var "a")) MP.<= (forall ["a", "b"] (tuple [var "a", var "b"])))
+        ((forall ["a"] (var "a")) <= (forall ["a", "b"] (tuple [var "a", var "b"])))
     -- test "mostSpecific"
     , testEqual
         "mostSpecific [Int, Str, forall a . a] = [Int, Str]"
-        (MP.mostSpecific [int, str, forall ["a"] (var "a")])
+        (mostSpecific [int, str, forall ["a"] (var "a")])
         [int, str]
     -- test "mostGeneral"
     , testEqual
         "mostGeneral [Int, Str, forall a . a] = forall a . a"
-        (MP.mostGeneral [int, str, forall ["a"] (var "a")])
+        (mostGeneral [int, str, forall ["a"] (var "a")])
         [forall ["a"] (var "a")]
     -- test mostSpecificSubtypes
     , testEqual
         "mostSpecificSubtypes: Int against [forall a . a]"
-        (MP.mostSpecificSubtypes int [forall ["a"] (var "a")])
+        (mostSpecificSubtypes int [forall ["a"] (var "a")])
         [forall ["a"] (var "a")]
     , testEqual
         "mostSpecificSubtypes: (Int -> Int)"
-        (MP.mostSpecificSubtypes (fun [int, int]) [fun [str,str], fun [int, int], forall ["a"] (fun [var "a", var "a"])])
+        (mostSpecificSubtypes (fun [int, int]) [fun [str,str], fun [int, int], forall ["a"] (fun [var "a", var "a"])])
         [fun [int, int]]
     , testEqual
         "mostSpecificSubtypes: empty"
-        (MP.mostSpecificSubtypes (fun [str, str, str]) [fun [real, real, real]])
+        (mostSpecificSubtypes (fun [str, str, str]) [fun [real, real, real]])
         []
 
     -- test mostSpecificSubtypes for tuples
     , testEqual
         "mostSpecificSubtypes: tuples"
-        (MP.mostSpecificSubtypes
+        (mostSpecificSubtypes
           (tuple [int, int])
           [ forall ["a"] (var "a")
           , forall ["a", "b"] (tuple [var "a", var "b"])
@@ -682,7 +681,7 @@ typeOrderTests =
     -- test mostSpecificSubtypes for tuples
     , testEqual
         "mostSpecificSubtypes: with partially generic tuples"
-        (MP.mostSpecificSubtypes
+        (mostSpecificSubtypes
           (forall ["a"] (tuple [int, var "a"]))
           [ forall ["a"] (var "a")
           , forall ["a", "b"] (tuple [var "a", var "b"])

From cf886c3c60579186216e82055ac47fd9a8e55986 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 4 Feb 2024 15:29:54 -0500
Subject: [PATCH 11/14] Update copyright date

---
 executable/Subcommands.hs                                      | 2 +-
 library/Morloc/BaseTypes.hs                                    | 2 +-
 library/Morloc/CodeGenerator/Generate.hs                       | 2 +-
 library/Morloc/CodeGenerator/Grammars/Common.hs                | 2 +-
 library/Morloc/CodeGenerator/Grammars/Macro.hs                 | 2 +-
 library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs        | 2 +-
 library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs | 2 +-
 library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs    | 2 +-
 library/Morloc/CodeGenerator/Grammars/Translator/R.hs          | 2 +-
 library/Morloc/CodeGenerator/Infer.hs                          | 2 +-
 library/Morloc/CodeGenerator/Namespace.hs                      | 2 +-
 library/Morloc/CodeGenerator/Nexus.hs                          | 2 +-
 library/Morloc/CodeGenerator/Serial.hs                         | 2 +-
 library/Morloc/Config.hs                                       | 2 +-
 library/Morloc/Data/Annotated.hs                               | 2 +-
 library/Morloc/Data/Bifoldable.hs                              | 2 +-
 library/Morloc/Data/Bifunctor.hs                               | 2 +-
 library/Morloc/Data/DAG.hs                                     | 2 +-
 library/Morloc/Data/Doc.hs                                     | 2 +-
 library/Morloc/Data/GMap.hs                                    | 2 +-
 library/Morloc/Data/Map.hs                                     | 2 +-
 library/Morloc/Data/Map/Extra.hs                               | 2 +-
 library/Morloc/Data/Rose.hs                                    | 2 +-
 library/Morloc/Data/Text.hs                                    | 2 +-
 library/Morloc/Frontend/API.hs                                 | 2 +-
 library/Morloc/Frontend/AST.hs                                 | 2 +-
 library/Morloc/Frontend/Lexer.hs                               | 2 +-
 library/Morloc/Frontend/Namespace.hs                           | 2 +-
 library/Morloc/Frontend/Parser.hs                              | 2 +-
 library/Morloc/Frontend/Restructure.hs                         | 2 +-
 library/Morloc/Frontend/Treeify.hs                             | 2 +-
 library/Morloc/Frontend/Typecheck.hs                           | 2 +-
 library/Morloc/Internal.hs                                     | 2 +-
 library/Morloc/Language.hs                                     | 2 +-
 library/Morloc/Module.hs                                       | 2 +-
 library/Morloc/Monad.hs                                        | 2 +-
 library/Morloc/Namespace.hs                                    | 2 +-
 library/Morloc/ProgramBuilder/Build.hs                         | 2 +-
 library/Morloc/Quasi.hs                                        | 2 +-
 library/Morloc/System.hs                                       | 2 +-
 library/Morloc/TypeEval.hs                                     | 2 +-
 library/Morloc/Typecheck/Internal.hs                           | 2 +-
 42 files changed, 42 insertions(+), 42 deletions(-)

diff --git a/executable/Subcommands.hs b/executable/Subcommands.hs
index 60e43916..95984809 100644
--- a/executable/Subcommands.hs
+++ b/executable/Subcommands.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Subcommands
 Description : Morloc executable subcommands
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/BaseTypes.hs b/library/Morloc/BaseTypes.hs
index 9524b1e0..611cf8ba 100644
--- a/library/Morloc/BaseTypes.hs
+++ b/library/Morloc/BaseTypes.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.BaseTypes
 Description : Definitions and functions for handling base types
-Copyright   : (c) Zebulun Arendsee, 2023
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Generate.hs b/library/Morloc/CodeGenerator/Generate.hs
index 08ee0770..13d47b7e 100644
--- a/library/Morloc/CodeGenerator/Generate.hs
+++ b/library/Morloc/CodeGenerator/Generate.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Generate
 Description : Translate AST forests into target language source code
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Common.hs b/library/Morloc/CodeGenerator/Grammars/Common.hs
index f76c993d..50d5c27a 100644
--- a/library/Morloc/CodeGenerator/Grammars/Common.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Common.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Common
 Description : A common set of utility functions for language templates
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Macro.hs b/library/Morloc/CodeGenerator/Grammars/Macro.hs
index cefeaeb4..63f29eb8 100644
--- a/library/Morloc/CodeGenerator/Grammars/Macro.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Macro.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Macro
 Description : Expand parameters in concrete types
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs b/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
index bb299a01..90967310 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/Cpp.hs
@@ -10,7 +10,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Translator.Cpp
 Description : C++ translator
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs b/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
index 4f657465..e06a4890 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/PseudoCode.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Translator.PseudoCode
 Description : Python3 translator
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs b/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
index 4f0d7950..a02a86ec 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/Python3.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Translator.Python3
 Description : Python3 translator
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Grammars/Translator/R.hs b/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
index 4a7c1637..e530b1af 100644
--- a/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
+++ b/library/Morloc/CodeGenerator/Grammars/Translator/R.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Grammars.Translator.R
 Description : R translator
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Infer.hs b/library/Morloc/CodeGenerator/Infer.hs
index 06b0fe0d..ba60cddd 100644
--- a/library/Morloc/CodeGenerator/Infer.hs
+++ b/library/Morloc/CodeGenerator/Infer.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Infer
 Description : Infer concrete types
-Copyright   : (c) Zebulun Arendsee, 2023
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Namespace.hs b/library/Morloc/CodeGenerator/Namespace.hs
index 2eb6365d..092915ac 100644
--- a/library/Morloc/CodeGenerator/Namespace.hs
+++ b/library/Morloc/CodeGenerator/Namespace.hs
@@ -7,7 +7,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Namespace
 Description : All code generator types and datastructures
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Nexus.hs b/library/Morloc/CodeGenerator/Nexus.hs
index 85fbe6ca..c9b2cc50 100644
--- a/library/Morloc/CodeGenerator/Nexus.hs
+++ b/library/Morloc/CodeGenerator/Nexus.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Nexus
 Description : Templates for generating a Perl nexus
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/CodeGenerator/Serial.hs b/library/Morloc/CodeGenerator/Serial.hs
index ebec9644..e996d57c 100644
--- a/library/Morloc/CodeGenerator/Serial.hs
+++ b/library/Morloc/CodeGenerator/Serial.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.CodeGenerator.Serial
 Description : Process serialization trees
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Config.hs b/library/Morloc/Config.hs
index 0acc54c5..0eb29bd5 100644
--- a/library/Morloc/Config.hs
+++ b/library/Morloc/Config.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Config
 Description : Handle local configuration
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Annotated.hs b/library/Morloc/Data/Annotated.hs
index c7a2896f..9ab28b2c 100644
--- a/library/Morloc/Data/Annotated.hs
+++ b/library/Morloc/Data/Annotated.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Data.Annotated
 Description : Class of annotated entities
-Copyright   : (c) Zebulun Arendsee, 2023
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Bifoldable.hs b/library/Morloc/Data/Bifoldable.hs
index 0b6e1ec4..9fd53032 100644
--- a/library/Morloc/Data/Bifoldable.hs
+++ b/library/Morloc/Data/Bifoldable.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Data.Bifoldable
 Description : The Bifoldable typeclass with monadic instances
-Copyright   : (c) Zebulun Arendsee, 2023
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Bifunctor.hs b/library/Morloc/Data/Bifunctor.hs
index 73076fab..7a3f37a5 100644
--- a/library/Morloc/Data/Bifunctor.hs
+++ b/library/Morloc/Data/Bifunctor.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Data.Bifunctor
 Description : The Bifunctor typeclass, with monadic instances
-Copyright   : (c) Zebulun Arendsee, 2023
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/DAG.hs b/library/Morloc/Data/DAG.hs
index 40a19762..71c02f21 100644
--- a/library/Morloc/Data/DAG.hs
+++ b/library/Morloc/Data/DAG.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Morloc.Data.DAG
 Description : Functions for working with directed acyclic graphs
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Doc.hs b/library/Morloc/Data/Doc.hs
index b538de2a..8d529250 100644
--- a/library/Morloc/Data/Doc.hs
+++ b/library/Morloc/Data/Doc.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Data.Doc
 Description : A wrapper around prettyprint
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/GMap.hs b/library/Morloc/Data/GMap.hs
index a780f111..fb8682fd 100644
--- a/library/Morloc/Data/GMap.hs
+++ b/library/Morloc/Data/GMap.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Data.GMap
 Description : A general map datatype (non-injective and non-surjective)
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Map.hs b/library/Morloc/Data/Map.hs
index c45c8cc2..a3d9397f 100644
--- a/library/Morloc/Data/Map.hs
+++ b/library/Morloc/Data/Map.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Data.Map
 Description : An extension of the base map module
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Map/Extra.hs b/library/Morloc/Data/Map/Extra.hs
index b87f2bc5..634bb52e 100644
--- a/library/Morloc/Data/Map/Extra.hs
+++ b/library/Morloc/Data/Map/Extra.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Data.Map.Extra
 Description : Additional functions for the Map class
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Rose.hs b/library/Morloc/Data/Rose.hs
index fe839610..3cd5864b 100644
--- a/library/Morloc/Data/Rose.hs
+++ b/library/Morloc/Data/Rose.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Data.Rose
 Description : The Rose tree data structure used for scoping in the parser
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Data/Text.hs b/library/Morloc/Data/Text.hs
index 07b658b8..24632385 100644
--- a/library/Morloc/Data/Text.hs
+++ b/library/Morloc/Data/Text.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Data.Text
 Description : All things text
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/API.hs b/library/Morloc/Frontend/API.hs
index 221bf4d6..8c2b0be4 100644
--- a/library/Morloc/Frontend/API.hs
+++ b/library/Morloc/Frontend/API.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Frontend.API
 Description : Morloc frontend API
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/AST.hs b/library/Morloc/Frontend/AST.hs
index a3434f21..ca7abad5 100644
--- a/library/Morloc/Frontend/AST.hs
+++ b/library/Morloc/Frontend/AST.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Frontend.AST
 Description : Functions for parsing the Expr abstract syntax trees
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Lexer.hs b/library/Morloc/Frontend/Lexer.hs
index f9820b83..d39969ac 100644
--- a/library/Morloc/Frontend/Lexer.hs
+++ b/library/Morloc/Frontend/Lexer.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Frontend.Lexer
 Description : Lexing functions used in the parser Morloc
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Namespace.hs b/library/Morloc/Frontend/Namespace.hs
index 463e4d88..60bcc218 100644
--- a/library/Morloc/Frontend/Namespace.hs
+++ b/library/Morloc/Frontend/Namespace.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.Frontend.Namespace
 Description : All frontend types and datastructures
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index ce03a580..fa9ac067 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Frontend.Parser
 Description : Full parser for Morloc
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Restructure.hs b/library/Morloc/Frontend/Restructure.hs
index ec67ab7b..122c31a8 100644
--- a/library/Morloc/Frontend/Restructure.hs
+++ b/library/Morloc/Frontend/Restructure.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Frontend.Restructure
 Description : Write Module objects to resolve type aliases and such
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index 71910463..a4f0573d 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Frontend.Treeify
 Description : Translate from the frontend DAG to the backend AnnoS AST forest
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index 86dc10a7..afe065e0 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Morloc.Frontend.Typecheck
 Description : Core inference module
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Internal.hs b/library/Morloc/Internal.hs
index c0f8f9fe..5cf3e228 100644
--- a/library/Morloc/Internal.hs
+++ b/library/Morloc/Internal.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Internal
 Description : Internal utility functions
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Language.hs b/library/Morloc/Language.hs
index d12b0b62..38bd004d 100644
--- a/library/Morloc/Language.hs
+++ b/library/Morloc/Language.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Language
 Description : Handling for specific languages
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Module.hs b/library/Morloc/Module.hs
index 8c970196..c57be4d4 100644
--- a/library/Morloc/Module.hs
+++ b/library/Morloc/Module.hs
@@ -4,7 +4,7 @@
 {-|
 Module      : Module
 Description : Morloc module imports and paths
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Monad.hs b/library/Morloc/Monad.hs
index eccef3cb..91bebf54 100644
--- a/library/Morloc/Monad.hs
+++ b/library/Morloc/Monad.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Monad
 Description : A great big stack of monads
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index b5d16eca..40e90c1e 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Namespace
 Description : All types and datastructures
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/ProgramBuilder/Build.hs b/library/Morloc/ProgramBuilder/Build.hs
index 997efb60..8b2a17af 100644
--- a/library/Morloc/ProgramBuilder/Build.hs
+++ b/library/Morloc/ProgramBuilder/Build.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.ProgramBuilder.Build
 Description : Manage system requirements and project building for pools
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Quasi.hs b/library/Morloc/Quasi.hs
index 3df67b51..f1624e56 100644
--- a/library/Morloc/Quasi.hs
+++ b/library/Morloc/Quasi.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Quasi
 Description : Define idoc quasiquotation for string interpolation
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/System.hs b/library/Morloc/System.hs
index 258834f0..2cd8a4a8 100644
--- a/library/Morloc/System.hs
+++ b/library/Morloc/System.hs
@@ -1,7 +1,7 @@
 {-|
 Module      : Morloc.System
 Description : General file system functions
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/TypeEval.hs b/library/Morloc/TypeEval.hs
index dd408b47..1c8ca6d5 100644
--- a/library/Morloc/TypeEval.hs
+++ b/library/Morloc/TypeEval.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.TypeEval
 Description : Functions for evaluating type expressions
-Copyright   : (c) Zebulun Arendsee, 2024
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental
diff --git a/library/Morloc/Typecheck/Internal.hs b/library/Morloc/Typecheck/Internal.hs
index 03e9e9c0..e4364cc1 100644
--- a/library/Morloc/Typecheck/Internal.hs
+++ b/library/Morloc/Typecheck/Internal.hs
@@ -3,7 +3,7 @@
 {-|
 Module      : Morloc.Typecheck.Internal
 Description : Functions for type checking and type manipulation
-Copyright   : (c) Zebulun Arendsee, 2021
+Copyright   : (c) Zebulun Arendsee, 2016-2024
 License     : GPL-3
 Maintainer  : zbwrnz@gmail.com
 Stability   : experimental

From d42a59315142e620c6aeb66a7de18820285198e3 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Sun, 4 Feb 2024 16:02:52 -0500
Subject: [PATCH 12/14] Separate typeclass and merge logic from Treeify

Treeify turns Expr's created by the parser into the SAnno/SExpr tree
used in the typechecker. Previously, it also collected all the
typeclasses, now I am breaking that logic into a new module. But the
new Typeclass module and Treeify use some of the same merging logic, so
I also created a new Merge module. The merge logic is very important in
morloc, since there are many implementations allowed, so it is
reasonable to have a dedicated module where the handling can be
carefully developed and unified.
---
 library/Morloc/Frontend/Classify.hs | 210 +++++++++++++++++++++++
 library/Morloc/Frontend/Merge.hs    |  91 ++++++++++
 library/Morloc/Frontend/Treeify.hs  | 256 +---------------------------
 3 files changed, 308 insertions(+), 249 deletions(-)
 create mode 100644 library/Morloc/Frontend/Classify.hs
 create mode 100644 library/Morloc/Frontend/Merge.hs

diff --git a/library/Morloc/Frontend/Classify.hs b/library/Morloc/Frontend/Classify.hs
new file mode 100644
index 00000000..c50acb8d
--- /dev/null
+++ b/library/Morloc/Frontend/Classify.hs
@@ -0,0 +1,210 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+Module      : Morloc.Frontend.Classify
+Description : Collect typeclasses
+Copyright   : (c) Zebulun Arendsee, 2016-2024
+License     : GPL-3
+Maintainer  : zbwrnz@gmail.com
+Stability   : experimental
+-}
+
+module Morloc.Frontend.Classify (linkTypeclasses) where
+
+import Morloc.Frontend.Namespace
+import Morloc.Data.Doc
+import qualified Control.Monad.State as CMS
+import qualified Morloc.Monad as MM
+import qualified Morloc.Data.Map as Map
+import qualified Morloc.Data.GMap as GMap
+import Morloc.Frontend.Merge (mergeTermTypes, weaveTermTypes, mergeTypeclasses, unionTermTypes)
+
+
+linkTypeclasses
+  :: MVar
+  -> ExprI
+  -> [(m, e, Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))]
+  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+linkTypeclasses _ e es
+  -- Merge the typeclasses and instances from all imported modules
+  -- These are inherited implicitly, so import terms are ignored
+  = Map.unionsWithM mergeTypeclasses [x | (_,_,x) <- es]
+  -- Augment the inherited map with the typeclasses and instances in this module
+  >>= findTypeclasses e
+
+
+findTypeclasses
+  :: ExprI
+  -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
+
+  -- first we collect all typeclass definitions in this module
+  -- typeclasses are defined only at the top-level, so no descent into sub-expressions
+  localClasses <- Map.unionsWithM mergeTypeclasses
+                . map makeClass
+                $ [(cls, vs, sigs) | (ExprI _ (ClsE cls vs sigs)) <- es0]
+
+  -- then merge them with all prior typeclasses and instances
+  allClasses <- Map.unionWithM mergeTypeclasses priorClasses localClasses
+
+  -- find instances in this module
+  -- The (IstE cls ts es) terms refer to
+  --   cls: typeclass, such as "Packable"
+  --   ts: types, such as ["Map a b", "[(a,b)]"]
+  --   es: instance definitions, such as source statements (the only ones
+  --       allowed at the moment)
+  let instances = [(cls, ts, es) | (ExprI _ (IstE cls ts es)) <- es0]
+
+  -- fold the instances into the current typeclass map and return
+  moduleClasses <- foldlM addInstance allClasses instances
+
+  MM.sayVVV $ "moduleClasses:"
+         <+> list (
+           map ( \ (v, (cls,vs,et,ts))
+                 -> pretty v <+> "="
+                 <+> pretty cls
+                 <+> pretty vs
+                 <+> parens (pretty (etype et))
+                 <+> list (map pretty ts)
+              ) (Map.toList moduleClasses)
+         )
+
+  mapM_ (linkVariablesToTypeclasses moduleClasses) es0
+
+  return moduleClasses
+
+  where
+    -- make a map of all terms that are defined in a typeclass (these will all
+    -- be general term)
+    makeClass :: (Typeclass, [TVar], [Signature]) -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+    makeClass (cls, vs, sigs) = Map.fromList $ map makeClassTerm sigs where
+      makeClassTerm :: Signature -> (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      makeClassTerm (Signature v _ t) = (v, (cls, vs, t, []))
+
+    addInstance
+      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+      -> (Typeclass, [TypeU], [ExprI])
+      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+    addInstance clsmap (_, _, []) = return clsmap
+    addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromListWith mergeInstances where
+      f :: ExprI -> MorlocMonad (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      f (ExprI srcIndex (SrcE src)) =
+        case Map.lookup (srcAlias src) clsmap of
+          (Just (cls1, vs, generalType, otherInstances)) -> do
+            MM.sayVVV $ "Adding SrcE instance:" <+> pretty (srcAlias src) <+> pretty srcIndex
+            when (cls1 /= cls0) (error "Conflicting instances")
+            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
+            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (requalify vs (etype generalType)) (zip vs ts0) }
+            let newTerm = TermTypes (Just instanceType) [(moduleName, Idx srcIndex src)] []
+            let typeterms = weaveTermTypes newTerm otherInstances
+            return (srcAlias src, (cls0, vs, generalType, typeterms))
+          Nothing -> error "No typeclass found for instance"
+
+      f (ExprI assIdx (AssE v e _)) =
+        case Map.lookup v clsmap of
+          (Just (cls1, vs, generalType, otherInstances)) -> do
+            MM.sayVVV $ "Adding AssE instance:" <+> pretty v <+> pretty assIdx
+            when (cls1 /= cls0) (error "Conflicting instances")
+            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
+            let instanceType = generalType { etype = foldl (\t (v',r) -> substituteTVar v' r t) (requalify vs (etype generalType)) (zip vs ts0) }
+            let newTerm = TermTypes (Just instanceType) [] [e]
+            let typeterms = weaveTermTypes newTerm otherInstances
+            return (v, (cls0, vs, generalType, typeterms))
+          Nothing -> error "No typeclass found for instance"
+
+      f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
+
+      mergeInstances
+        :: (Typeclass, [TVar], EType, [TermTypes])
+        -> (Typeclass, [TVar], EType, [TermTypes])
+        -> (Typeclass, [TVar], EType, [TermTypes])
+      mergeInstances (cls1, vs1, e1, ts1) (cls2, vs2, e2, ts2)
+        | cls1 == cls2, length vs1 == length vs2, equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
+        | otherwise = error "failed to merge"
+
+      requalify :: [TVar] -> TypeU -> TypeU
+      requalify (v:vs) (ForallU v' t)
+        | v == v' = requalify vs t
+        | otherwise = ForallU v' (requalify vs t)
+      requalify _ t = t
+
+    linkVariablesToTypeclasses
+      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+      -> ExprI
+      -> MorlocMonad ()
+    linkVariablesToTypeclasses = link where
+      link :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> ExprI -> MorlocMonad ()
+      -- The following may have terms from typeclasses
+      -- 1. variables
+      link m (ExprI i (VarE v)) = setClass m i v
+      -- recurse into assignments, allow shadowing of typeclass functions (TODO: warn)
+      link m (ExprI _ (AssE _ (ExprI _ (LamE ks e)) es)) = do
+        -- shadow all terms bound under the lambda
+        let m' = foldr Map.delete m ks
+        mapM_ (link m') (e:es)
+      link m (ExprI _ (AssE _ e es)) = mapM_ (link m) (e:es)
+      -- modules currently cannot be nested (should this be allowed?)
+      link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
+      -- everything below boilerplate
+      link m (ExprI _ (AccE _ e)) = link m e
+      link m (ExprI _ (LstE xs)) = mapM_ (link m) xs
+      link m (ExprI _ (TupE xs)) = mapM_ (link m) xs
+      link m (ExprI _ (LamE vs e)) = link (foldr Map.delete m vs) e
+      link m (ExprI _ (AppE f es)) = link m f >> mapM_ (link m) es
+      link m (ExprI _ (AnnE e _)) = link m e
+      link m (ExprI _ (NamE rs)) = mapM_ (link m . snd) rs
+      link _ _ = return ()
+
+      setClass :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
+      setClass m termIndex v = case Map.lookup v m of
+        (Just (cls, _, t, ts)) -> do
+
+          MM.sayVVV $ "setClass map:" <+> viaShow m
+
+          mapM_ (mapSources cls v t) ts
+          mapM_ (mapExpressions cls v t) ts
+
+          s <- CMS.get
+          -- Yes, both indices are termIndex. After typechecking, the
+          -- polymorphic type will resolve to monomorphic. Each may resolve
+          -- differently, so instances must not all point to the same signature.
+          newMap <- GMap.insertWithM mergeSignatureSet termIndex termIndex (Polymorphic cls v t ts) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap
+                     , stateName = Map.insert termIndex v (stateName s)})
+          return ()
+        Nothing -> return ()
+
+      mapSources :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapSources cls v gt t = mapM_ (mapSource . snd) (termConcrete t) where
+        mapSource :: Indexed Source -> MorlocMonad ()
+        mapSource (Idx i src) = do
+          let t' = TermTypes (termGeneral t) [(mv, srcidx) | (mv, srcidx) <- termConcrete t, val srcidx == src] []
+          MM.sayVVV $ "mapSource" <+> pretty i <+> pretty src
+                    <> "\n  termGeneral t:" <+> pretty (termGeneral t)
+                    <> "\n  termGeneral t':" <+> pretty (termGeneral t')
+                    <> "\n  length (termConcrete t):" <+> pretty (length (termConcrete t))
+                    <> "\n  length (termConcrete t'):" <+> pretty (length (termConcrete t'))
+          s <- CMS.get
+          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap })
+          return ()
+
+      mapExpressions :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapExpressions cls v gt t = mapM_ mapExpression (termDecl t) where
+        mapExpression :: ExprI -> MorlocMonad ()
+        mapExpression (ExprI i _) = do
+          MM.sayVVV $ "mapExpression" <+> pretty i
+          s <- CMS.get
+          let t' = TermTypes (termGeneral t) [] [e | e@(ExprI i' _) <- termDecl t, i' == i]
+          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
+          CMS.put (s { stateSignatures = newMap })
+          return ()
+
+      mergeSignatureSet :: SignatureSet -> SignatureSet -> MorlocMonad SignatureSet
+      mergeSignatureSet (Polymorphic cls1 v1 t1 ts1) (Polymorphic cls2 v2 t2 ts2)
+        | cls1 == cls2 && equivalent (etype t1) (etype t2) && v1 == v2 = return $ Polymorphic cls1 v1 t1 (unionTermTypes ts1 ts2)
+        | otherwise = error "Invalid SignatureSet merge"
+      mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> mergeTermTypes ts1 ts2
+      mergeSignatureSet _ _ = undefined
+findTypeclasses _ _ = undefined
diff --git a/library/Morloc/Frontend/Merge.hs b/library/Morloc/Frontend/Merge.hs
new file mode 100644
index 00000000..05dc486f
--- /dev/null
+++ b/library/Morloc/Frontend/Merge.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+Module      : Morloc.Frontend.Merge
+Description : Merge various things
+Copyright   : (c) Zebulun Arendsee, 2016-2024
+License     : GPL-3
+Maintainer  : zbwrnz@gmail.com
+Stability   : experimental
+
+Since morloc allows co-existence of many different implementations, the ever
+new definition needs to be merged in with all the pre-existing ones. Further,
+we need to avoid many identical copies of on instance. The purpose of this
+module is to curate the functions for merging different terms.
+-}
+
+module Morloc.Frontend.Merge
+  ( mergeTermTypes
+  , weaveTermTypes
+  , mergeEType
+  , mergeTypeUs
+  , mergeTypeclasses
+  , unionTermTypes
+  ) where
+
+
+-- TODO: tighten all this up, formalize these operations and follow the
+-- conventions below. Make a typeclass for these mergeable types.
+--
+-- union :: [a] -> [a] -> Either MorlocError [a]
+-- weave :: a -> [a] -> Either MorlocError [a]
+-- merge :: a -> a -> Either MorlocError a
+
+
+import Morloc.Frontend.Namespace
+import qualified Morloc.Monad as MM
+
+mergeTermTypes :: TermTypes -> TermTypes -> MorlocMonad TermTypes
+mergeTermTypes (TermTypes g1 cs1 es1) (TermTypes g2 cs2 es2)
+  = TermTypes
+  <$> maybeCombine mergeEType g1 g2
+  <*> pure (unique (cs1 <> cs2))
+  <*> pure (unique (es1 <> es2))
+  where
+  -- either combine terms or take the first on that is defined, or whatever
+  maybeCombine :: Monad m => (a -> a -> m a) -> Maybe a -> Maybe a -> m (Maybe a)
+  maybeCombine f (Just a) (Just b) = Just <$> f a b
+  maybeCombine _ (Just a) _ = return $ Just a
+  maybeCombine _ _ (Just b) = return $ Just b
+  maybeCombine _ _ _ = return Nothing
+
+
+-- Add one new TermTypes object into a list
+weaveTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
+weaveTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
+  | equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
+  | otherwise = t2 : weaveTermTypes t1 ts
+weaveTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
+  weaveTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
+weaveTermTypes TermTypes{} (TermTypes{}:_) = error "what the why?"
+weaveTermTypes t1 [] = [t1]
+
+-- | This function defines how general types are merged. There are decisions
+-- encoded in this function that should be vary carefully considered.
+--  * Can properties simply be concatenated?
+--  * What if constraints are contradictory?
+mergeEType :: EType -> EType -> MorlocMonad EType
+mergeEType (EType t1 ps1 cs1) (EType t2 ps2 cs2)
+  = EType <$> mergeTypeUs t1 t2 <*> pure (ps1 <> ps2) <*> pure (cs1 <> cs2)
+
+
+-- merge two general types
+mergeTypeUs :: TypeU -> TypeU -> MorlocMonad TypeU
+mergeTypeUs t1 t2
+  | equivalent t1 t2 = return t1
+  | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
+
+mergeTypeclasses
+  :: (Typeclass, [TVar], EType, [TermTypes])
+  -> (Typeclass, [TVar], EType, [TermTypes])
+  -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
+mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
+  | cls1 /= cls2 = error "Conflicting typeclasses"
+  | not (equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
+  | length vs1 /= length vs2 = error "Conflicting typeclass parameter count"
+  -- here I should do reciprocal subtyping
+  | otherwise = return (cls1, vs1, t1, unionTermTypes ts1 ts2)
+
+
+unionTermTypes :: [TermTypes] -> [TermTypes] -> [TermTypes]
+unionTermTypes ts1 ts2 = foldr weaveTermTypes ts2 ts1
diff --git a/library/Morloc/Frontend/Treeify.hs b/library/Morloc/Frontend/Treeify.hs
index a4f0573d..09566752 100644
--- a/library/Morloc/Frontend/Treeify.hs
+++ b/library/Morloc/Frontend/Treeify.hs
@@ -19,6 +19,9 @@ import qualified Morloc.Monad as MM
 import qualified Morloc.Data.DAG as DAG
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.Data.GMap as GMap
+import Morloc.Frontend.Classify (linkTypeclasses)
+import Morloc.Frontend.Merge (mergeTermTypes, mergeEType)
+  
 
 -- | Every term must either be sourced or declared.
 data TermOrigin = Declared ExprI | Sourced Source
@@ -134,7 +137,7 @@ linkSignaturesModule
   -> MorlocMonad (Map.Map EVar TermTypes)
 linkSignaturesModule _ (ExprI _ (ModE v es)) edges
   -- a map from alias to all signatures associated with the alias
-  = Map.mapM (foldlM combineTermTypes (TermTypes Nothing [] []))
+  = Map.mapM (foldlM mergeTermTypes (TermTypes Nothing [] []))
               (Map.unionsWith (<>) [unalias es' m' | (_, es', m') <- edges]) >>=
     linkSignatures v es
   where
@@ -228,9 +231,9 @@ linkVariablesToTermTypes mv m0 = mapM_ (link m0) where
 unifyTermTypes :: MVar -> [ExprI] -> Map.Map EVar TermTypes -> MorlocMonad (Map.Map EVar TermTypes)
 unifyTermTypes mv xs m0
   = Map.mergeMapsM fb fc fbc sigs srcs
-  >>= Map.mapKeysWithM combineTermTypes (\(v,_,_) -> v)
-  >>= Map.unionWithM combineTermTypes m0
-  >>= Map.unionWithM combineTermTypes decs
+  >>= Map.mapKeysWithM mergeTermTypes (\(v,_,_) -> v)
+  >>= Map.unionWithM mergeTermTypes m0
+  >>= Map.unionWithM mergeTermTypes decs
   where
   sigs = Map.fromListWith (<>) [((v, l, Nothing), [t]) | (ExprI _ (SigE (Signature v l t))) <- xs]
   srcs = Map.fromListWith (<>) [((srcAlias s, srcLabel s, langOf s), [(s, i)]) | (ExprI i (SrcE s)) <- xs]
@@ -258,36 +261,6 @@ unifyTermTypes mv xs m0
     return $ TermTypes gt [(mv, Idx i src) | (src, i) <- srcs'] []
 
 
-combineTermTypes :: TermTypes -> TermTypes -> MorlocMonad TermTypes
-combineTermTypes (TermTypes g1 cs1 es1) (TermTypes g2 cs2 es2)
-  = TermTypes
-  <$> maybeCombine mergeEType g1 g2
-  <*> pure (unique (cs1 <> cs2))
-  <*> pure (unique (es1 <> es2))
-  where
-  -- either combine terms or take the first on that is defined, or whatever
-  maybeCombine :: Monad m => (a -> a -> m a) -> Maybe a -> Maybe a -> m (Maybe a)
-  maybeCombine f (Just a) (Just b) = Just <$> f a b
-  maybeCombine _ (Just a) _ = return $ Just a
-  maybeCombine _ _ (Just b) = return $ Just b
-  maybeCombine _ _ _ = return Nothing
-
--- | This function defines how general types are merged. There are decisions
--- encoded in this function that should be vary carefully considered.
---  * Can properties simply be concatenated?
---  * What if constraints are contradictory?
-mergeEType :: EType -> EType -> MorlocMonad EType
-mergeEType (EType t1 ps1 cs1) (EType t2 ps2 cs2)
-  = EType <$> mergeTypeUs t1 t2 <*> pure (ps1 <> ps2) <*> pure (cs1 <> cs2)
-
-
--- merge two general types
-mergeTypeUs :: TypeU -> TypeU -> MorlocMonad TypeU
-mergeTypeUs t1 t2
-  | equivalent t1 t2 = return t1
-  | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
-
-
 linkAndRemoveAnnotations :: ExprI -> MorlocMonad ExprI
 linkAndRemoveAnnotations = f where
   f :: ExprI -> MorlocMonad ExprI
@@ -417,218 +390,3 @@ newIndex i = do
   i' <- MM.getCounter
   copyState i i'
   return i'
-
-
-linkTypeclasses
-  :: MVar
-  -> ExprI
-  -> [(m, e, Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))]
-  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
-linkTypeclasses _ e es
-  -- Merge the typeclasses and instances from all imported modules
-  -- These are inherited implicitly, so import terms are ignored
-  = Map.unionsWithM mergeTypeclasses [x | (_,_,x) <- es]
-  -- Augment the inherited map with the typeclasses and instances in this module
-  >>= findTypeclasses e
-
-
-findTypeclasses
-  :: ExprI
-  -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
-findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
-
-  -- first we collect all typeclass definitions in this module
-  -- typeclasses are defined only at the top-level, so no descent into sub-expressions
-  localClasses <- Map.unionsWithM mergeTypeclasses
-                . map makeClass
-                $ [(cls, vs, sigs) | (ExprI _ (ClsE cls vs sigs)) <- es0]
-
-  -- then merge them with all prior typeclasses and instances
-  allClasses <- Map.unionWithM mergeTypeclasses priorClasses localClasses
-
-  -- find instances in this module
-  -- The (IstE cls ts es) terms refer to
-  --   cls: typeclass, such as "Packable"
-  --   ts: types, such as ["Map a b", "[(a,b)]"]
-  --   es: instance definitions, such as source statements (the only ones
-  --       allowed at the moment)
-  let instances = [(cls, ts, es) | (ExprI _ (IstE cls ts es)) <- es0]
-
-  -- fold the instances into the current typeclass map and return
-  moduleClasses <- foldlM addInstance allClasses instances
-
-  MM.sayVVV $ "moduleClasses:"
-         <+> list (
-           map ( \ (v, (cls,vs,et,ts))
-                 -> pretty v <+> "="
-                 <+> pretty cls
-                 <+> pretty vs
-                 <+> parens (pretty (etype et))
-                 <+> list (map pretty ts)
-              ) (Map.toList moduleClasses)
-         )
-
-  mapM_ (linkVariablesToTypeclasses moduleClasses) es0
-
-  return moduleClasses
-
-  where
-    -- make a map of all terms that are defined in a typeclass (these will all
-    -- be general term)
-    makeClass :: (Typeclass, [TVar], [Signature]) -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-    makeClass (cls, vs, sigs) = Map.fromList $ map makeClassTerm sigs where
-      makeClassTerm :: Signature -> (EVar, (Typeclass, [TVar], EType, [TermTypes]))
-      makeClassTerm (Signature v _ t) = (v, (cls, vs, t, []))
-
-    addInstance
-      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-      -> (Typeclass, [TypeU], [ExprI])
-      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
-    addInstance clsmap (_, _, []) = return clsmap
-    addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromListWith mergeInstances where
-      f :: ExprI -> MorlocMonad (EVar, (Typeclass, [TVar], EType, [TermTypes]))
-      f (ExprI srcIndex (SrcE src)) =
-        case Map.lookup (srcAlias src) clsmap of
-          (Just (cls1, vs, generalType, otherInstances)) -> do
-            MM.sayVVV $ "Adding SrcE instance:" <+> pretty (srcAlias src) <+> pretty srcIndex
-            when (cls1 /= cls0) (error "Conflicting instances")
-            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
-            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (requalify vs (etype generalType)) (zip vs ts0) }
-            let newTerm = TermTypes (Just instanceType) [(moduleName, Idx srcIndex src)] []
-            let typeterms = mergeTermTypes newTerm otherInstances
-            return (srcAlias src, (cls0, vs, generalType, typeterms))
-          Nothing -> error "No typeclass found for instance"
-
-      f (ExprI assIdx (AssE v e _)) =
-        case Map.lookup v clsmap of
-          (Just (cls1, vs, generalType, otherInstances)) -> do
-            MM.sayVVV $ "Adding AssE instance:" <+> pretty v <+> pretty assIdx
-            when (cls1 /= cls0) (error "Conflicting instances")
-            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
-            let instanceType = generalType { etype = foldl (\t (v',r) -> substituteTVar v' r t) (requalify vs (etype generalType)) (zip vs ts0) }
-            let newTerm = TermTypes (Just instanceType) [] [e]
-            let typeterms = mergeTermTypes newTerm otherInstances
-            return (v, (cls0, vs, generalType, typeterms))
-          Nothing -> error "No typeclass found for instance"
-
-      f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
-
-      mergeInstances
-        :: (Typeclass, [TVar], EType, [TermTypes])
-        -> (Typeclass, [TVar], EType, [TermTypes])
-        -> (Typeclass, [TVar], EType, [TermTypes])
-      mergeInstances (cls1, vs1, e1, ts1) (cls2, vs2, e2, ts2)
-        | cls1 == cls2, length vs1 == length vs2, equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
-        | otherwise = error "failed to merge"
-
-      requalify :: [TVar] -> TypeU -> TypeU
-      requalify (v:vs) (ForallU v' t)
-        | v == v' = requalify vs t
-        | otherwise = ForallU v' (requalify vs t)
-      requalify _ t = t
-
-    linkVariablesToTypeclasses
-      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-      -> ExprI
-      -> MorlocMonad ()
-    linkVariablesToTypeclasses = link where
-      link :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> ExprI -> MorlocMonad ()
-      -- The following may have terms from typeclasses
-      -- 1. variables
-      link m (ExprI i (VarE v)) = setClass m i v
-      -- recurse into assignments, allow shadowing of typeclass functions (TODO: warn)
-      link m (ExprI _ (AssE _ (ExprI _ (LamE ks e)) es)) = do
-        -- shadow all terms bound under the lambda
-        let m' = foldr Map.delete m ks
-        mapM_ (link m') (e:es)
-      link m (ExprI _ (AssE _ e es)) = mapM_ (link m) (e:es)
-      -- modules currently cannot be nested (should this be allowed?)
-      link _ (ExprI _ (ModE v _)) = MM.throwError $ NestedModule v
-      -- everything below boilerplate
-      link m (ExprI _ (AccE _ e)) = link m e
-      link m (ExprI _ (LstE xs)) = mapM_ (link m) xs
-      link m (ExprI _ (TupE xs)) = mapM_ (link m) xs
-      link m (ExprI _ (LamE vs e)) = link (foldr Map.delete m vs) e
-      link m (ExprI _ (AppE f es)) = link m f >> mapM_ (link m) es
-      link m (ExprI _ (AnnE e _)) = link m e
-      link m (ExprI _ (NamE rs)) = mapM_ (link m . snd) rs
-      link _ _ = return ()
-
-      setClass :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
-      setClass m termIndex v = case Map.lookup v m of
-        (Just (cls, _, t, ts)) -> do
-
-          MM.sayVVV $ "setClass map:" <+> viaShow m
-
-          mapM_ (mapSources cls v t) ts
-          mapM_ (mapExpressions cls v t) ts
-
-          s <- CMS.get
-          -- Yes, both indices are termIndex. After typechecking, the
-          -- polymorphic type will resolve to monomorphic. Each may resolve
-          -- differently, so instances must not all point to the same signature.
-          newMap <- GMap.insertWithM mergeSignatureSet termIndex termIndex (Polymorphic cls v t ts) (stateSignatures s)
-          CMS.put (s { stateSignatures = newMap
-                     , stateName = Map.insert termIndex v (stateName s)})
-          return ()
-        Nothing -> return ()
-
-      mapSources :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
-      mapSources cls v gt t = mapM_ (mapSource . snd) (termConcrete t) where
-        mapSource :: Indexed Source -> MorlocMonad ()
-        mapSource (Idx i src) = do
-          let t' = TermTypes (termGeneral t) [(mv, srcidx) | (mv, srcidx) <- termConcrete t, val srcidx == src] []
-          MM.sayVVV $ "mapSource" <+> pretty i <+> pretty src
-                    <> "\n  termGeneral t:" <+> pretty (termGeneral t)
-                    <> "\n  termGeneral t':" <+> pretty (termGeneral t')
-                    <> "\n  length (termConcrete t):" <+> pretty (length (termConcrete t))
-                    <> "\n  length (termConcrete t'):" <+> pretty (length (termConcrete t'))
-          s <- CMS.get
-          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
-          CMS.put (s { stateSignatures = newMap })
-          return ()
-
-      mapExpressions :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
-      mapExpressions cls v gt t = mapM_ mapExpression (termDecl t) where
-        mapExpression :: ExprI -> MorlocMonad ()
-        mapExpression (ExprI i _) = do
-          MM.sayVVV $ "mapExpression" <+> pretty i
-          s <- CMS.get
-          let t' = TermTypes (termGeneral t) [] [e | e@(ExprI i' _) <- termDecl t, i' == i]
-          newMap <- GMap.insertWithM mergeSignatureSet i i (Polymorphic cls v gt [t']) (stateSignatures s)
-          CMS.put (s { stateSignatures = newMap })
-          return ()
-
-      mergeSignatureSet :: SignatureSet -> SignatureSet -> MorlocMonad SignatureSet
-      mergeSignatureSet (Polymorphic cls1 v1 t1 ts1) (Polymorphic cls2 v2 t2 ts2)
-        | cls1 == cls2 && equivalent (etype t1) (etype t2) && v1 == v2 = return $ Polymorphic cls1 v1 t1 (unionTermTypes ts1 ts2)
-        | otherwise = error "Invalid SignatureSet merge"
-      mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> combineTermTypes ts1 ts2
-      mergeSignatureSet _ _ = undefined
-findTypeclasses _ _ = undefined
-
-unionTermTypes :: [TermTypes] -> [TermTypes] -> [TermTypes]
-unionTermTypes ts1 ts2 = foldr mergeTermTypes ts2 ts1
-
-mergeTermTypes :: TermTypes -> [TermTypes] -> [TermTypes]
-mergeTermTypes t1@(TermTypes (Just gt1) srcs1 es1) (t2@(TermTypes (Just gt2) srcs2 es2):ts)
-  | equivalent (etype gt1) (etype gt2) = TermTypes (Just gt1) (unique (srcs1 <> srcs2)) (es1 <> es2) : ts
-  | otherwise = t2 : mergeTermTypes t1 ts
-mergeTermTypes (TermTypes Nothing srcs1 es1) ((TermTypes e2 srcs2 es2):ts2) =
-  mergeTermTypes (TermTypes e2 (srcs1 <> srcs2) (es1 <> es2)) ts2
-mergeTermTypes TermTypes{} (TermTypes{}:_) = error "what the why?"
-mergeTermTypes t1 [] = [t1]
-
-
-
-mergeTypeclasses
-  :: (Typeclass, [TVar], EType, [TermTypes])
-  -> (Typeclass, [TVar], EType, [TermTypes])
-  -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
-mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
-  | cls1 /= cls2 = error "Conflicting typeclasses"
-  | not (equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
-  | length vs1 /= length vs2 = error "Conflicting typeclass parameter count"
-  -- here I should do reciprocal subtyping
-  | otherwise = return (cls1, vs1, t1, unionTermTypes ts1 ts2)

From 43ac5ed136344900dfce3b65dc8b4fc281568ecf Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Thu, 8 Feb 2024 21:09:30 -0500
Subject: [PATCH 13/14] (420 pass) Packers now use classes

I have implemented an impoverished typeclasses system. Quite unlike
Haskel dictionary passing, I store all instances in each variable. It
strikes me as not so memory efficient. I also suspect there are not so
unlikely corner cases that blow up exponentially. But damn performance.
I also do not know if my system is sound, but so long as I don't look
too closely, and no one else does either, I should be able to write my
paper and pretend all is jolly. I will formalize everything, but first
you loosen your purse strings. For seven years I worked without pay, so
now I shall give you Leah. You want type theory, actually pay me for
another seven years and I'll give you a pretty Rachel. My metaphors may
be backward, but I didn't want to marry my mother. For now, I will show
you truth in a handful of tests.
---
 library/Morloc/CodeGenerator/Serial.hs        |  35 +++-
 library/Morloc/Frontend/Classify.hs           | 181 ++++++++++++++----
 library/Morloc/Frontend/Merge.hs              |   6 +-
 library/Morloc/Frontend/Namespace.hs          |   1 -
 library/Morloc/Frontend/Parser.hs             |  45 +----
 library/Morloc/Frontend/Restructure.hs        |  88 +--------
 library/Morloc/Frontend/Typecheck.hs          | 159 ++++++++++-----
 library/Morloc/Monad.hs                       |  39 ----
 library/Morloc/Namespace.hs                   |  57 +++---
 library/Morloc/Typecheck/Internal.hs          |  10 +
 test-suite/Main.hs                            |   2 +
 .../golden-tests/import-2/localmap/main.loc   |  12 +-
 .../packer-definitions-1/main.loc             |  12 +-
 .../packer-definitions-2/lib/json/main.loc    |  16 +-
 .../packer-definitions-5/main.loc             |  30 +--
 test-suite/golden-tests/records-2/foo.loc     |  11 +-
 .../golden-tests/serial-form-8-r/Makefile     |   2 +-
 .../golden-tests/serial-form-8-r/exp.txt      |   2 +-
 .../golden-tests/serial-form-8-r/foo.loc      |   4 +-
 .../golden-tests/type-identities-c/foo.loc    |  27 +--
 .../golden-tests/typeclasses-3/Makefile       |   8 +
 test-suite/golden-tests/typeclasses-3/exp.txt |   2 +
 test-suite/golden-tests/typeclasses-3/foo.hpp |  18 ++
 test-suite/golden-tests/typeclasses-3/foo.py  |   8 +
 .../golden-tests/typeclasses-3/main.loc       |  23 +++
 .../golden-tests/typeclasses-4/Makefile       |   7 +
 test-suite/golden-tests/typeclasses-4/exp.txt |   1 +
 test-suite/golden-tests/typeclasses-4/foo.py  |  15 ++
 .../golden-tests/typeclasses-4/main.loc       |  22 +++
 29 files changed, 512 insertions(+), 331 deletions(-)
 create mode 100644 test-suite/golden-tests/typeclasses-3/Makefile
 create mode 100644 test-suite/golden-tests/typeclasses-3/exp.txt
 create mode 100644 test-suite/golden-tests/typeclasses-3/foo.hpp
 create mode 100644 test-suite/golden-tests/typeclasses-3/foo.py
 create mode 100644 test-suite/golden-tests/typeclasses-3/main.loc
 create mode 100644 test-suite/golden-tests/typeclasses-4/Makefile
 create mode 100644 test-suite/golden-tests/typeclasses-4/exp.txt
 create mode 100644 test-suite/golden-tests/typeclasses-4/foo.py
 create mode 100644 test-suite/golden-tests/typeclasses-4/main.loc

diff --git a/library/Morloc/CodeGenerator/Serial.hs b/library/Morloc/CodeGenerator/Serial.hs
index e996d57c..83ef1d07 100644
--- a/library/Morloc/CodeGenerator/Serial.hs
+++ b/library/Morloc/CodeGenerator/Serial.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
 
 {-|
 Module      : Morloc.CodeGenerator.Serial
@@ -81,6 +81,32 @@ shallowType (SerialString x) = VarF x
 shallowType (SerialNull   x) = VarF x
 shallowType (SerialUnknown v) = UnkF v
 
+findPackers :: Lang -> MorlocMonad
+  ( [(([TVar], TypeU), Source)]
+  , [(([TVar], TypeU), Source)]
+  )
+findPackers lang = do
+  sigmap <- MM.gets stateTypeclasses
+
+  MM.sayVVV $ "findPackers"
+            <> "\n  sigmap:" <+> viaShow sigmap
+
+  packers <- case Map.lookup (EV "pack") sigmap of
+    (Just (_, _, _, ts)) -> return $ concatMap f ts
+    Nothing -> return []
+
+  unpackers <- case Map.lookup (EV "unpack") sigmap of
+    (Just (_, _, _, ts)) -> return $ concatMap f ts
+    Nothing -> return []
+
+  return (packers, unpackers)
+  where
+    f :: TermTypes -> [(([TVar], TypeU), Source)]
+    f (TermTypes (Just et) (map (val . snd) -> srcs) _) =
+      let (vs, t) = unqualify $ etype et
+      in [((vs, t), src) | src <- srcs, srcLang src == lang]
+    f (TermTypes Nothing _ _) = []
+
 -- Takes a map of packers with concrete type names as keys. A single concrete
 -- type name may map to many single types. For example, the python type "dict"
 -- might represent a Map with homogenous keys and values or many things that
@@ -91,9 +117,8 @@ shallowType (SerialUnknown v) = UnkF v
 -- will be done through subtyping.
 makeSerialAST :: Int -> Lang -> TypeF -> MorlocMonad SerialAST
 makeSerialAST m lang t0 = do
-  -- [(([TVar], TypeU), Source)]
-  packs   <- MM.metaUniversalMogrifiers lang |>> Map.lookup Pack   |>> fromMaybe [] |>> map (first unqualify)
-  unpacks <- MM.metaUniversalMogrifiers lang |>> Map.lookup Unpack |>> fromMaybe [] |>> map (first unqualify)
+  -- ([(([TVar], TypeU), Source)], ...)
+  (packs, unpacks) <- findPackers lang
 
   MM.sayVVV $ "packs:" <+> viaShow packs
   MM.sayVVV $ "unpacks:" <+> viaShow unpacks
@@ -165,7 +190,7 @@ makeSerialAST m lang t0 = do
             selection <- selectPacker (zip packers unpacked)
             return $ SerialPack v selection
           Nothing -> serializerError
-            $ "Cannot find constructor in AppF" <+> dquotes (pretty v)
+            $ "Could not find" <+> pretty generalTypeName <+> "from" <+> dquotes (pretty v)
             <> "\n  t:" <+> pretty t
             <> "\n  typepackers:" <+> viaShow typepackers
       where
diff --git a/library/Morloc/Frontend/Classify.hs b/library/Morloc/Frontend/Classify.hs
index c50acb8d..8fcf21a6 100644
--- a/library/Morloc/Frontend/Classify.hs
+++ b/library/Morloc/Frontend/Classify.hs
@@ -17,14 +17,16 @@ import qualified Control.Monad.State as CMS
 import qualified Morloc.Monad as MM
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.Data.GMap as GMap
+import qualified Morloc.Data.Text as DT
+import Morloc.Typecheck.Internal (unqualify, qualify)
 import Morloc.Frontend.Merge (mergeTermTypes, weaveTermTypes, mergeTypeclasses, unionTermTypes)
 
 
 linkTypeclasses
   :: MVar
   -> ExprI
-  -> [(m, e, Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))]
-  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+  -> [(m, e, Map.Map EVar (ClassName, [TVar], EType, [TermTypes]))]
+  -> MorlocMonad (Map.Map EVar (ClassName, [TVar], EType, [TermTypes]))
 linkTypeclasses _ e es
   -- Merge the typeclasses and instances from all imported modules
   -- These are inherited implicitly, so import terms are ignored
@@ -32,13 +34,13 @@ linkTypeclasses _ e es
   -- Augment the inherited map with the typeclasses and instances in this module
   >>= findTypeclasses e
 
-
 findTypeclasses
   :: ExprI
-  -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-  -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+  -> Map.Map EVar (ClassName, [TVar], EType, [TermTypes])
+  -> MorlocMonad (Map.Map EVar (ClassName, [TVar], EType, [TermTypes]))
 findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
 
+
   -- first we collect all typeclass definitions in this module
   -- typeclasses are defined only at the top-level, so no descent into sub-expressions
   localClasses <- Map.unionsWithM mergeTypeclasses
@@ -70,6 +72,8 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
               ) (Map.toList moduleClasses)
          )
 
+  _ <- updateTypeclasses moduleClasses
+
   mapM_ (linkVariablesToTypeclasses moduleClasses) es0
 
   return moduleClasses
@@ -77,64 +81,74 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
   where
     -- make a map of all terms that are defined in a typeclass (these will all
     -- be general term)
-    makeClass :: (Typeclass, [TVar], [Signature]) -> Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+    makeClass :: (ClassName, [TVar], [Signature]) -> Map.Map EVar (ClassName, [TVar], EType, [TermTypes])
     makeClass (cls, vs, sigs) = Map.fromList $ map makeClassTerm sigs where
-      makeClassTerm :: Signature -> (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      makeClassTerm :: Signature -> (EVar, (ClassName, [TVar], EType, [TermTypes]))
       makeClassTerm (Signature v _ t) = (v, (cls, vs, t, []))
 
     addInstance
-      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
-      -> (Typeclass, [TypeU], [ExprI])
-      -> MorlocMonad (Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]))
+      :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes])
+      -> (ClassName, [TypeU], [ExprI])
+      -> MorlocMonad (Map.Map EVar (ClassName, [TVar], EType, [TermTypes]))
     addInstance clsmap (_, _, []) = return clsmap
     addInstance clsmap (cls0, ts0, es) = mapM f es |>> Map.fromListWith mergeInstances where
-      f :: ExprI -> MorlocMonad (EVar, (Typeclass, [TVar], EType, [TermTypes]))
+      f :: ExprI -> MorlocMonad (EVar, (ClassName, [TVar], EType, [TermTypes]))
       f (ExprI srcIndex (SrcE src)) =
         case Map.lookup (srcAlias src) clsmap of
           (Just (cls1, vs, generalType, otherInstances)) -> do
-            MM.sayVVV $ "Adding SrcE instance:" <+> pretty (srcAlias src) <+> pretty srcIndex
-            when (cls1 /= cls0) (error "Conflicting instances")
-            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
-            let instanceType = generalType { etype = foldl (\t (v,r) -> substituteTVar v r t) (requalify vs (etype generalType)) (zip vs ts0) }
-            let newTerm = TermTypes (Just instanceType) [(moduleName, Idx srcIndex src)] []
-            let typeterms = weaveTermTypes newTerm otherInstances
+            when (cls1 /= cls0) (MM.throwError $ ConflictingClasses cls1 cls0 (srcAlias src))
+            when (length vs /= length ts0) (MM.throwError $ InstanceSizeMismatch cls1 vs ts0)
+            instanceType <- substituteInstanceTypes vs (etype generalType) ts0
+            let newTerm = TermTypes (Just $ generalType {etype = instanceType}) [(moduleName, Idx srcIndex src)] []
+                typeterms = weaveTermTypes newTerm otherInstances
+
+            MM.sayVVV $ "addInstance src:"
+                      <> "\n    v:" <+> pretty (srcAlias src)
+                      <> "\n  cls:" <+> pretty cls1
+                      <> "\n  generalType:" <+> pretty generalType
+                      <> "\n  ts0:" <+> encloseSep "{" "}" ";" (map pretty ts0)
+                      <> "\n  instanceType:" <+> pretty instanceType
+                      <> "\n  newTerm:" <+> pretty newTerm
+
             return (srcAlias src, (cls0, vs, generalType, typeterms))
-          Nothing -> error "No typeclass found for instance"
+          Nothing ->  MM.throwError $ MissingTypeclassDefinition cls0 (srcAlias src)
 
-      f (ExprI assIdx (AssE v e _)) =
+      f (ExprI _ (AssE v e _)) =
         case Map.lookup v clsmap of
           (Just (cls1, vs, generalType, otherInstances)) -> do
-            MM.sayVVV $ "Adding AssE instance:" <+> pretty v <+> pretty assIdx
-            when (cls1 /= cls0) (error "Conflicting instances")
-            when (length vs /= length ts0) (error "Conflicting class and instance parameter count")
-            let instanceType = generalType { etype = foldl (\t (v',r) -> substituteTVar v' r t) (requalify vs (etype generalType)) (zip vs ts0) }
-            let newTerm = TermTypes (Just instanceType) [] [e]
-            let typeterms = weaveTermTypes newTerm otherInstances
+            when (cls1 /= cls0) (MM.throwError $ ConflictingClasses cls1 cls0 v)
+            when (length vs /= length ts0) (MM.throwError $ InstanceSizeMismatch cls1 vs ts0)
+            instanceType <- substituteInstanceTypes vs (etype generalType) ts0
+            let newTerm = TermTypes (Just $ generalType {etype = instanceType}) [] [e]
+                typeterms = weaveTermTypes newTerm otherInstances
+
+            MM.sayVVV $ "addInstance decl:"
+                      <> "\n    v:" <+> pretty v
+                      <> "\n  cls:" <+> pretty cls1
+                      <> "\n  generalType:" <+> pretty generalType
+                      <> "\n  ts0:" <+> encloseSep "{" "}" ";" (map pretty ts0)
+                      <> "\n  instanceType:" <+> pretty instanceType
+                      <> "\n  newTerm:" <+> pretty newTerm
+
             return (v, (cls0, vs, generalType, typeterms))
-          Nothing -> error "No typeclass found for instance"
+          Nothing -> MM.throwError $ MissingTypeclassDefinition cls0 v
 
-      f _ = error "Only source statements are currently allowed in instances (generalization is in development)"
+      f (ExprI _ e) = MM.throwError $ IllegalExpressionInInstance cls0 ts0 e
 
       mergeInstances
-        :: (Typeclass, [TVar], EType, [TermTypes])
-        -> (Typeclass, [TVar], EType, [TermTypes])
-        -> (Typeclass, [TVar], EType, [TermTypes])
+        :: (ClassName, [TVar], EType, [TermTypes])
+        -> (ClassName, [TVar], EType, [TermTypes])
+        -> (ClassName, [TVar], EType, [TermTypes])
       mergeInstances (cls1, vs1, e1, ts1) (cls2, vs2, e2, ts2)
         | cls1 == cls2, length vs1 == length vs2, equivalent (etype e1) (etype e2) = (cls1, vs1, e1, unionTermTypes ts1 ts2)
         | otherwise = error "failed to merge"
 
-      requalify :: [TVar] -> TypeU -> TypeU
-      requalify (v:vs) (ForallU v' t)
-        | v == v' = requalify vs t
-        | otherwise = ForallU v' (requalify vs t)
-      requalify _ t = t
-
     linkVariablesToTypeclasses
-      :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes])
+      :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes])
       -> ExprI
       -> MorlocMonad ()
     linkVariablesToTypeclasses = link where
-      link :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> ExprI -> MorlocMonad ()
+      link :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes]) -> ExprI -> MorlocMonad ()
       -- The following may have terms from typeclasses
       -- 1. variables
       link m (ExprI i (VarE v)) = setClass m i v
@@ -156,7 +170,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
       link m (ExprI _ (NamE rs)) = mapM_ (link m . snd) rs
       link _ _ = return ()
 
-      setClass :: Map.Map EVar (Typeclass, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
+      setClass :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes]) -> Int -> EVar -> MorlocMonad ()
       setClass m termIndex v = case Map.lookup v m of
         (Just (cls, _, t, ts)) -> do
 
@@ -175,7 +189,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
           return ()
         Nothing -> return ()
 
-      mapSources :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapSources :: ClassName -> EVar -> EType -> TermTypes -> MorlocMonad ()
       mapSources cls v gt t = mapM_ (mapSource . snd) (termConcrete t) where
         mapSource :: Indexed Source -> MorlocMonad ()
         mapSource (Idx i src) = do
@@ -190,7 +204,7 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
           CMS.put (s { stateSignatures = newMap })
           return ()
 
-      mapExpressions :: Typeclass -> EVar -> EType -> TermTypes -> MorlocMonad ()
+      mapExpressions :: ClassName -> EVar -> EType -> TermTypes -> MorlocMonad ()
       mapExpressions cls v gt t = mapM_ mapExpression (termDecl t) where
         mapExpression :: ExprI -> MorlocMonad ()
         mapExpression (ExprI i _) = do
@@ -207,4 +221,89 @@ findTypeclasses (ExprI _ (ModE moduleName es0)) priorClasses = do
         | otherwise = error "Invalid SignatureSet merge"
       mergeSignatureSet (Monomorphic ts1) (Monomorphic ts2) = Monomorphic <$> mergeTermTypes ts1 ts2
       mergeSignatureSet _ _ = undefined
+
+    updateTypeclasses :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes]) -> MorlocMonad ()
+    updateTypeclasses m = do
+      s <- MM.get
+      newMap <- Map.unionWithM mergeTypeclasses m (stateTypeclasses s)
+      MM.put (s {stateTypeclasses = newMap})
+
 findTypeclasses _ _ = undefined
+
+
+{- Substitute the instance types into the class function definition
+
+Suppose we have the following class and instances:
+
+class Reversible a b where
+  forward :: a -> b
+  backward :: b -> a
+
+instance Reversible ([a],[b]) [(a,b)] where
+  ...
+
+If we are handling the single instance above for the `forward` function:
+
+  classVars: [a, b]
+  classType: forall a b . a -> b
+  instanceParameters: forall a b . ([a], [b])
+                      forall a b . [(a, b)]
+
+and the return type should be
+
+  forall a b . ([a],[b]) -> [(a,b)]
+
+A problem here is that the instance parameters *share* qualifiers. The `a` and `b`
+in the first instance parameter are the same as those in the second. But not the
+same as the `a` and `b` in the class.
+
+
+-}
+substituteInstanceTypes :: [TVar] -> TypeU -> [TypeU] -> MorlocMonad TypeU
+substituteInstanceTypes classVars classType instanceParameters = do
+
+      -- find all qualifiers in the instance parameter list
+  let instanceQualifiers = unique $ concatMap (fst . unqualify) instanceParameters
+
+      -- rewrite the class type such that the class qualifiers appear first and
+      -- do not conflict with parameter qualifiers
+      cleanClassType = replaceQualifiers instanceQualifiers (putClassVarsFirst classType)
+
+      -- substitute in the parameter types
+      finalType = qualify instanceQualifiers
+                $ substituteQualifiers cleanClassType (map (snd . unqualify) instanceParameters)
+
+  MM.sayVVV $ "substituteInstanceTypes"
+            <> "\n  classVars:" <+> pretty classVars
+            <> "\n  classType:" <+> pretty classType
+            <> "\n  instanceParameters:" <+> pretty instanceParameters
+            <> "\n  -------------------"
+            <> "\n  instanceQualifiers:" <+> pretty instanceQualifiers
+            <> "\n  cleanClassType:" <+> pretty cleanClassType
+            <> "\n  finalType:" <+> pretty finalType
+
+  return finalType
+
+  where
+    putClassVarsFirst :: TypeU -> TypeU
+    putClassVarsFirst t =
+      let (vs, t') = unqualify t
+      in qualify (classVars <> filter (`notElem` classVars) vs) t'
+
+    replaceQualifiers :: [TVar] -> TypeU -> TypeU
+    replaceQualifiers vs0 t0 = f vs0 [r | r <- freshVariables, r `notElem` doNotUse] t0
+      where
+
+      -- qualifiers to avoid when replacing
+      doNotUse = vs0 <> (fst . unqualify) t0
+
+      f (v:vs) (r:rs) (ForallU v' t)
+        | v == v' = ForallU r . f vs rs $ substituteTVar v' (VarU r) t
+        | otherwise = ForallU v' (f (v:vs) (r:rs) t)
+      f _ _ t = t
+
+      freshVariables = [1 ..] >>= flip replicateM ['a' .. 'z'] |>> TV . DT.pack
+
+    substituteQualifiers :: TypeU -> [TypeU] -> TypeU
+    substituteQualifiers (ForallU v t) (r:rs) = substituteQualifiers (substituteTVar v r t) rs
+    substituteQualifiers t _ = t
diff --git a/library/Morloc/Frontend/Merge.hs b/library/Morloc/Frontend/Merge.hs
index 05dc486f..1f8d0cf4 100644
--- a/library/Morloc/Frontend/Merge.hs
+++ b/library/Morloc/Frontend/Merge.hs
@@ -76,9 +76,9 @@ mergeTypeUs t1 t2
   | otherwise = MM.throwError $ IncompatibleGeneralType t1 t2
 
 mergeTypeclasses
-  :: (Typeclass, [TVar], EType, [TermTypes])
-  -> (Typeclass, [TVar], EType, [TermTypes])
-  -> MorlocMonad (Typeclass, [TVar], EType, [TermTypes])
+  :: (ClassName, [TVar], EType, [TermTypes])
+  -> (ClassName, [TVar], EType, [TermTypes])
+  -> MorlocMonad (ClassName, [TVar], EType, [TermTypes])
 mergeTypeclasses (cls1, vs1, t1, ts1) (cls2, vs2, t2, ts2)
   | cls1 /= cls2 = error "Conflicting typeclasses"
   | not (equivalent (etype t1) (etype t2)) = error "Conflicting typeclass term general type"
diff --git a/library/Morloc/Frontend/Namespace.hs b/library/Morloc/Frontend/Namespace.hs
index 60bcc218..60826604 100644
--- a/library/Morloc/Frontend/Namespace.hs
+++ b/library/Morloc/Frontend/Namespace.hs
@@ -66,7 +66,6 @@ copyState oldIndex newIndex = do
     { stateSignatures = updateGMap (stateSignatures s)
     , stateConcreteTypedefs = updateGMap (stateConcreteTypedefs s)
     , stateGeneralTypedefs = updateGMap (stateGeneralTypedefs s)
-    , stateInnerMogrifiers = updateGMap (stateInnerMogrifiers s)
     , stateSources = updateGMap (stateSources s)
     , stateAnnotations = updateMap (stateAnnotations s)
     , stateExports = updateList (stateExports s)
diff --git a/library/Morloc/Frontend/Parser.hs b/library/Morloc/Frontend/Parser.hs
index fa9ac067..c084b821 100644
--- a/library/Morloc/Frontend/Parser.hs
+++ b/library/Morloc/Frontend/Parser.hs
@@ -103,42 +103,13 @@ pModule expModuleName = do
     findSymbols :: ExprI -> Set.Set Symbol
     findSymbols (ExprI _ (TypE _ v _ _)) = Set.singleton $ TypeSymbol v
     findSymbols (ExprI _ (AssE e _ _)) = Set.singleton $ TermSymbol e
-    findSymbols (ExprI _ (SigE (Signature e _ t))) = Set.union (Set.singleton $ TermSymbol e) (packedType t)
+    findSymbols (ExprI _ (SigE (Signature e _ _))) = Set.singleton $ TermSymbol e
     findSymbols (ExprI _ (ImpE (Import _ (Just imps) _ _)))
         = Set.fromList $ [TermSymbol alias | (AliasedTerm _ alias) <- imps] <>
                          [TypeSymbol alias | (AliasedType _ alias) <- imps]
     findSymbols (ExprI _ (SrcE src)) = Set.singleton $ TermSymbol (srcAlias src)
     findSymbols _ = Set.empty
 
-    -- When (un)packers are defined, the type that is being (un)packed is not
-    -- declared. But some modules may export only their (un)packed type. When
-    -- this is the case, importing nothing from the module causes the module to
-    -- be removed and the packers are never found. To remedy this, I am adding
-    -- the (un)packed type to the export list.
-    packedType :: EType -> Set.Set Symbol
-    packedType e
-      | Set.member Pack (eprop e) = packType (etype e)
-      | Set.member Unpack (eprop e) = unpackType (etype e)
-      | otherwise = Set.empty
-
-    unpackType :: TypeU -> Set.Set Symbol
-    unpackType (ForallU _ t) = unpackType t
-    unpackType (FunU [t] _) = symbolOfTypeU t
-    unpackType _ = error "Invalid unpacker"
-
-    packType :: TypeU -> Set.Set Symbol
-    packType (ForallU _ t) = packType t
-    packType (FunU _ t) = symbolOfTypeU t
-    packType _ = error "Invalid packer"
-
-    symbolOfTypeU :: TypeU -> Set.Set Symbol
-    symbolOfTypeU (VarU v) = Set.singleton $ TypeSymbol v
-    symbolOfTypeU (ExistU v _ _) = Set.singleton $ TypeSymbol v
-    symbolOfTypeU (ForallU _ t) = symbolOfTypeU t
-    symbolOfTypeU (AppU t _) = symbolOfTypeU t
-    symbolOfTypeU (FunU _ _) = error "So, you want to pack a function? I'm accepting PRs."
-    symbolOfTypeU NamU{} = error "You don't need a packer for a record type of thing."
-
 
 -- | match an implicit Main module
 pMain :: Parser ExprI
@@ -269,15 +240,15 @@ pTypeclass = do
   _ <- reserved "class"
   (TV v, vs) <- pTypedefTerm <|> parens pTypedefTerm
   sigs <- option [] (reserved "where" >> alignInset pSignature)
-  exprI $ ClsE (Typeclass v) vs sigs
+  exprI $ ClsE (ClassName v) vs sigs
 
 pInstance :: Parser ExprI
 pInstance = do
   _ <- reserved "instance"
   v <- freenameU
-  ts <- many1 pType
+  ts <- many1 pTypeGen
   es <- option [] (reserved "where" >> alignInset pInstanceExpr) |>> concat
-  exprI $ IstE (Typeclass v) ts es
+  exprI $ IstE (ClassName v) ts es
   where
     pInstanceExpr :: Parser [ExprI]
     pInstanceExpr
@@ -441,13 +412,7 @@ pSignature = do
     return ps
 
   pProperty :: Parser Property
-  pProperty = do
-    ps <- many1 freename
-    case ps of
-      ["pack"] -> return Pack
-      ["unpack"] -> return Unpack
-      ["cast"] -> return Cast
-      _ -> return (GeneralProperty ps)
+  pProperty = Property <$> many1 freename
 
   pConstraints :: Parser [Constraint]
   pConstraints = reserved "where" >> alignInset pConstraint where
diff --git a/library/Morloc/Frontend/Restructure.hs b/library/Morloc/Frontend/Restructure.hs
index 122c31a8..a87d2462 100644
--- a/library/Morloc/Frontend/Restructure.hs
+++ b/library/Morloc/Frontend/Restructure.hs
@@ -21,7 +21,6 @@ import qualified Morloc.BaseTypes as BT
 import qualified Morloc.Data.Map as Map
 import qualified Morloc.TypeEval as TE
 import qualified Data.Set as Set
-import Morloc.Typecheck.Internal (qualify, unqualify)
 
 -- | Resolve type aliases, term aliases and import/exports
 restructure
@@ -31,8 +30,8 @@ restructure s
   = checkForSelfRecursion s -- modules should not import themselves
   >>= resolveImports -- rewrite DAG edges to map imported terms to their aliases
   >>= doM collectTypes
+  >>= doM collectSources
   >>= evaluateAllTypes
-  >>= doM collectMogrifiers
   >>= removeTypeImports -- Remove type imports and exports
   |>> nullify -- TODO: unsus and document
 
@@ -281,93 +280,30 @@ evaluateAllTypes = MDD.mapNodeM f where
       either MM.throwError return $ TE.evaluateType gscope t
 
 
-collectMogrifiers :: DAG MVar [AliasedSymbol] ExprI -> MorlocMonad ()
-collectMogrifiers fullDag = do
-  let typeDag = MDD.mapEdge (\xs -> [(x,y) | AliasedType x y <- xs]) fullDag
-  _ <- MDD.synthesizeDAG formMogrifiers typeDag
-
-  s <- MM.get
-  let (GMap _ (Map.elems -> propMap)) = stateInnerMogrifiers s
-  MM.put (s {stateUniversalInnerMogrifiers = Map.unionsWith mergeMogs propMap })
 
+collectSources :: DAG MVar [AliasedSymbol] ExprI -> MorlocMonad ()
+collectSources fullDag = do
+  let typeDag = MDD.mapEdge (\xs -> [(x,y) | AliasedType x y <- xs]) fullDag
+  _ <- MDD.synthesizeDAG linkSources typeDag
   return ()
   where
 
-  mergeMogs :: [(TypeU, Source)] -> [(TypeU, Source)] -> [(TypeU, Source)]
-  mergeMogs xs0 ys0 = filter (isNovel ys0) xs0 <> ys0 where
-    isNovel :: [(TypeU, Source)] -> (TypeU, Source) -> Bool
-    isNovel [] _ = True
-    isNovel ((t1, src1):ys) x@(t2, src2)
-      | srcPath src1 == srcPath src2 &&
-        srcName src1 == srcName src2 &&
-        isSubtypeOf t1 t2 &&
-        isSubtypeOf t2 t1 = False
-      | otherwise = isNovel ys x
-
-  formMogrifiers
-    :: MVar
-    -> ExprI
-    -> [( MVar -- child module name
-        , [(TVar, TVar)] -- alias map
-        , Map.Map Property [(TypeU, Source)]
-        )]
-    -> MorlocMonad (Map.Map Property [(TypeU, Source)])
-  formMogrifiers m e0 childImports = do
+  linkSources :: MVar -> ExprI -> a -> MorlocMonad ()
+  linkSources m e0 _ = do
 
     -- collect and store sources (should this be done here?)
     let objSources = AST.findSources e0
 
-    let localMogs = prepareMogrifier objSources (AST.findSignatures e0)
-
-    let inheritedMogs = [inherit aliasMap mogMap | (_, aliasMap, mogMap) <- childImports]
-      -- loop over childImports
-      -- rename as needed first
-      -- then keep the mogrifiers that varmatch the alias
-      --
-
-    let mogrifiers = Map.unionsWith mergeMogs (localMogs : inheritedMogs)
-
     -- Here we are creating links from every indexed term in the module to the module
     -- sources and aliases. When the module abstractions are factored out later,
     -- this will be the only way to access module-specific info.
     let indices = AST.getIndices e0
 
     s <- MM.get
-    MM.put (s { stateSources = GMap.insertManyWith (<>) indices m objSources (stateSources s)
-              , stateInnerMogrifiers = GMap.insertManyWith (<>) indices m mogrifiers (stateInnerMogrifiers s)
-              } )
+    MM.put (s { stateSources = GMap.insertManyWith (<>) indices m objSources (stateSources s) } )
 
-    MM.sayVVV $ "mogrifiers for" <+> pretty m <> ":" <+> viaShow mogrifiers
+    return ()
 
-    return mogrifiers
-
-    where
-      prepareMogrifier :: [Source] -> [(EVar, Maybe Label, EType)] -> Map.Map Property [(TypeU, Source)]
-      prepareMogrifier srcs es = mogrifiers
-        where
-          srcMap = Map.fromListWith (<>) [(srcAlias src, [src]) | src <- srcs]
-          mogMaybe = concat [[(p, (etype e, Map.lookup v srcMap)) | p <- Set.toList (eprop e)] | (v, _, e) <- es]
-          mogrifiers = Map.fromListWith (<>) [(p, [(t, src) | src <- srcs']) | (p, (t, Just srcs')) <- mogMaybe]
-
-      inherit :: [(TVar, TVar)] -> Map.Map Property [(TypeU, Source)] -> Map.Map Property [(TypeU, Source)]
-      inherit aliasMap mogMap
-        = Map.mapWithKey (selectInherited (map snd aliasMap))
-        . Map.map ( map (first (renameMog aliasMap)) )
-        $  mogMap
-
-      -- determine whether a given mogrifier is inherited given the import list
-      selectInherited :: [TVar] -> Property -> [(TypeU, Source)] -> [(TypeU, Source)]
-      selectInherited aliases Unpack ((unqualify -> (vs, t@(FunU [a] _)), src):xs)
-        | extractKey a `elem` aliases = (qualify vs t, src) : selectInherited aliases Unpack xs
-        | otherwise = selectInherited aliases Unpack xs
-      selectInherited aliases Pack ((unqualify -> (vs, t@(FunU [_] b)), src):xs)
-        | extractKey b `elem` aliases = (qualify vs t, src) : selectInherited aliases Pack xs
-        | otherwise = selectInherited aliases Pack xs
-      selectInherited _ _ xs = xs -- currently keep all functions for other mogrifiers (none of these are currently used)
-
-      -- update type names in the inherited signatures
-      renameMog :: [(TVar, TVar)] -> TypeU -> TypeU
-      renameMog aliasMap t0 = foldl (\t (s,a) -> rename s a t) t0 aliasMap
 
 
 -- Rename a variable. For example:
@@ -407,7 +343,6 @@ nullify = MDD.mapNode f where
     nullifyT (NamU o v ds rs) = NamU o v (map nullifyT ds) (map (second nullifyT) rs)
     nullifyT t = t
 
-
     isNull :: TypeU -> Bool
     isNull t = t == BT.unitU
 
@@ -416,7 +351,6 @@ removeTypeImports :: DAG MVar [AliasedSymbol] ExprI -> MorlocMonad (DAG MVar [(E
 removeTypeImports d = case MDD.roots d of
   [root] -> return
           . MDD.shake root
-          . MDD.filterEdge filterEmpty
           . MDD.mapEdge (mapMaybe maybeEVar)
           $ d
   roots -> MM.throwError $ NonSingularRoot roots
@@ -424,7 +358,3 @@ removeTypeImports d = case MDD.roots d of
     maybeEVar :: AliasedSymbol -> Maybe (EVar, EVar)
     maybeEVar (AliasedTerm x y) = Just (x, y)
     maybeEVar (AliasedType _ _) = Nothing -- remove type symbols, they have already been used
-
-    filterEmpty :: k -> n -> k -> [a] -> Bool
-    filterEmpty _ _ _ [] = False
-    filterEmpty _ _ _ _ = True
diff --git a/library/Morloc/Frontend/Typecheck.hs b/library/Morloc/Frontend/Typecheck.hs
index afe065e0..d3939db8 100644
--- a/library/Morloc/Frontend/Typecheck.hs
+++ b/library/Morloc/Frontend/Typecheck.hs
@@ -47,12 +47,8 @@ typecheck = mapM run where
       insetSay "========================================================"
       let e3 = mapAnnoSG (fmap normalizeType) . applyGen g2 $ e2
 
-      resolveInstances g2 (applyGen g2 e3)
-
-      -- s2 <- MM.gets stateSignatures
-      -- MM.sayVVV $ "resolved stateSignatures:\n  " <> pretty s2
-      --
-      -- return e4
+      (g3, e4) <- resolveInstances g2 e3
+      return (applyGen g3 e4)
 
 -- TypeU --> Type
 resolveTypes :: AnnoS (Indexed TypeU) Many Int -> AnnoS (Indexed Type) Many Int
@@ -74,38 +70,82 @@ resolveTypes (AnnoS (Idx i t) ci e)
   f (StrS x) = StrS x
   f UniS = UniS
 
-resolveInstances :: Gamma -> AnnoS (Indexed TypeU) ManyPoly Int -> MorlocMonad (AnnoS (Indexed TypeU) Many Int)
-resolveInstances g (AnnoS gi@(Idx _ gt) ci e0) = AnnoS gi ci <$> f e0 where
-  f :: ExprS (Indexed TypeU) ManyPoly Int -> MorlocMonad (ExprS (Indexed TypeU) Many Int)
+resolveInstances :: Gamma -> AnnoS (Indexed TypeU) ManyPoly Int -> MorlocMonad (Gamma, AnnoS (Indexed TypeU) Many Int)
+resolveInstances g (AnnoS gi@(Idx _ gt) ci e0) = do
+    (g', e1) <- f g e0
+    return (g', AnnoS gi ci e1)
+  where
+  f :: Gamma -> ExprS (Indexed TypeU) ManyPoly Int -> MorlocMonad (Gamma, ExprS (Indexed TypeU) Many Int)
 
   -- resolve instances
-  f (VarS v (PolymorphicExpr _ _ _ rss)) = do
-        -- collect all implementations and apply context
-    let es = [AnnoS (Idx i (apply g t)) c e | (AnnoS (Idx i t) c e) <- concatMap snd rss]
-        -- find the types of the most specific instances that are subtypes of the inferred type
-        mostSpecificTypes = mostSpecificSubtypes gt [t | (AnnoS (Idx _ t) _ _) <- es]
-        -- filter out the most specific subtype expressions
-        es' = [AnnoS (Idx i t) c e | (AnnoS (Idx i t) c e) <- es, t `elem` mostSpecificTypes]
-    VarS v . Many <$> mapM (resolveInstances g) es'
-
-  f (VarS v (MonomorphicExpr _ xs)) = VarS v . Many <$> mapM (resolveInstances g) xs
-
+  f g0 (VarS v (PolymorphicExpr clsName _ _ rss)) = do
+
+    -- find all instances that are a subtype of the inferred type
+    let rssSubtypes = [x | x@(EType t _ _, _) <- rss, isSubtypeOf2 t gt]
+
+    -- find the most specific instance
+    (g2, es1) <- case mostSpecific [t | (EType t _ _, _) <- rssSubtypes] of
+      -- if there is exactly one most specific instance, go forward
+      [mostSpecificType] -> do
+        -- filter out the instances with the most specific type
+        let es0 = concat [rs | (t, rs) <- rssSubtypes, etype t == mostSpecificType]
+
+        MM.sayVVV $ "resolveInstances:"
+                  <> "\n  es0:" <+> encloseSep "{" "}" "," (map pretty es0)
+                  <> "\n  mostSpecificType:" <+> pretty mostSpecificType
+                  <> "\n  gt:" <+> pretty gt
+
+        g1 <- connectInstance g0 es0
+        return (g1, es0)
+      -- if there are no suitable instances, die
+      [] -> do
+        MM.sayVVV $ "resolveInstance empty"
+                  <> "\n  rss:" <+> pretty rss
+                  <> "\n  gt:" <+> pretty gt
+        return undefined
+      -- if there are many suitable instances, still die (maybe add handling for
+      -- less conherent cases later)
+      manyTypes -> do
+        MM.sayVVV $ "resolveInstance too many"
+                  <> "\n  manyTypes:" <+> encloseSep "{" "}" "," (map pretty manyTypes)
+                  <> "\n  rssSubtypes:" <+> pretty rssSubtypes
+                  <> "\n  gt:" <+> pretty gt
+        return undefined
+
+    (g3, es2) <- statefulMapM resolveInstances g2 es1
+
+    return (g3, VarS v (Many es2))
+
+  f g0 (VarS v (MonomorphicExpr _ xs)) = statefulMapM resolveInstances g0 xs |>> second (VarS v . Many)
   -- propagate
-  f (AccS k e) = AccS k <$> resolveInstances g e
-  f (AppS e es) = AppS <$> resolveInstances g e <*> mapM (resolveInstances g) es
-  f (LamS vs e) = LamS vs <$> resolveInstances g e
-  f (LstS es) = LstS <$> mapM (resolveInstances g) es
-  f (TupS es) = TupS <$> mapM (resolveInstances g) es
-  f (NamS rs) = NamS <$> mapM (secondM (resolveInstances g)) rs
+  f g0 (AccS k e) = resolveInstances g0 e |>> second (AccS k)
+  f g0 (AppS e es) = do
+    (g1, e') <- resolveInstances g0 e
+    (g2, es') <- statefulMapM resolveInstances g1 es
+    return (g2, AppS e' es')
+  f g0 (LamS vs e) = resolveInstances g0 e |>> second (LamS vs)
+  f g0 (LstS es) = statefulMapM resolveInstances g0 es |>> second LstS
+  f g0 (TupS es) = statefulMapM resolveInstances g0 es |>> second TupS
+  f g0 (NamS rs) = do
+    (g1, es') <- statefulMapM resolveInstances g0 (map snd rs)
+    return (g1, NamS (zip (map fst rs) es'))
 
   -- primitives
-  f UniS = return UniS
-  f (BndS v) = return $ BndS v
-  f (RealS x) = return $ RealS x
-  f (IntS x) = return $ IntS x
-  f (LogS x) = return $ LogS x
-  f (StrS x) = return $ StrS x
-  f (CallS x) = return $ CallS x
+  f g0 UniS = return (g0, UniS)
+  f g0 (BndS v) = return (g0, BndS v)
+  f g0 (RealS x) = return (g0, RealS x)
+  f g0 (IntS x) = return (g0, IntS x)
+  f g0 (LogS x) = return (g0, LogS x)
+  f g0 (StrS x) = return (g0, StrS x)
+  f g0 (CallS x) = return (g0, CallS x)
+
+  connectInstance :: Gamma -> [AnnoS (Indexed TypeU) f c] -> MorlocMonad Gamma
+  connectInstance g0 [] = return g0
+  connectInstance g0 (AnnoS (Idx _ t) _ _ : es) =
+    case subtype gt t g0 of
+      (Left e) -> MM.throwError $ GeneralTypeError e
+      (Right g1) -> connectInstance g1 es
+
 
 
 -- prepare a general, indexed typechecking error
@@ -300,25 +340,37 @@ synthE _ g (VarS v (MonomorphicExpr Nothing [])) = do
   return (g', t, VarS v (MonomorphicExpr Nothing []))
 
 synthE i g0 (VarS v (PolymorphicExpr cls clsName t0 rs0)) = do
-  let (g1, t1) = toExistential g0 (etype t0)
-  rs' <- checkInstances g1 t1 rs0
-  return (g1, t1, VarS v (PolymorphicExpr cls clsName t0 rs'))
-
+  (g1, rs') <- checkInstances g0 (etype t0) rs0
+  let (g2, t1) = rename g1 (etype t0)
+  return (g2, t1, VarS v (PolymorphicExpr cls clsName t0 rs'))
   where
-
     -- check each instance
     -- do not return modified Gamma state
     checkInstances
       :: Gamma
       -> TypeU
       -> [(EType, [AnnoS Int ManyPoly Int])]
-      -> MorlocMonad [(EType, [AnnoS (Indexed TypeU) ManyPoly Int])]
-    checkInstances _ _ [] = return []
+      -> MorlocMonad (Gamma, [(EType, [AnnoS (Indexed TypeU) ManyPoly Int])])
+    checkInstances g _ [] = return (g, [])
     checkInstances g10 genType ((instType, es):rs) = do
-      rs' <- checkInstances g10 genType rs
-      g11 <- subtype' i (etype instType) genType g10
-      es' <- checkImplementations g11 genType es
-      return ((instType, es'):rs')
+
+      -- check this first instance
+      -- convert qualified terms in the general type to existentials
+      let (g11, genType') = toExistential g10 genType
+      -- rename the instance type
+      let (g12, instType') = rename g11 (etype instType)
+      -- subtype the renamed instance type against the existential general
+      g13 <- subtype' i instType' genType' g12
+      -- check all implementations for this instance
+      (g14, es') <- checkImplementations g13 genType' es
+
+      -- check all remaining instances
+      -- Use the ORIGINAL general type, not the existntialized one above.
+      -- this means each existential can be solved independently for each
+      -- instance.
+      (g15, rs') <- checkInstances g14 genType rs
+
+      return (g15, (instType, es'):rs')
 
     -- check each implementation within each instance
     -- do not return modified Gamma state
@@ -326,12 +378,19 @@ synthE i g0 (VarS v (PolymorphicExpr cls clsName t0 rs0)) = do
       :: Gamma
       -> TypeU
       -> [AnnoS Int ManyPoly Int]
-      -> MorlocMonad [AnnoS (Indexed TypeU) ManyPoly Int]
-    checkImplementations _ _ [] = return []
-    checkImplementations g t (e:es) = do
-      es' <- checkImplementations g t es
-      (_, _, e') <- checkG g e t
-      return (e':es')
+      -> MorlocMonad (Gamma, [AnnoS (Indexed TypeU) ManyPoly Int])
+    checkImplementations g _ [] = return (g, [])
+    checkImplementations g10 t (e:es) = do
+
+      -- check this instance
+      (g11, _, e') <- checkG g10 e t
+
+      -- check all the remaining implementations
+      (g12, es') <- checkImplementations g11 t es
+
+      -- return the final context and the applied expressions
+      return (g12, applyGen g12 e':es')
+
 
 -- This case will only be encountered in check, the existential generated here
 -- will be subtyped against the type known from the VarS case.
diff --git a/library/Morloc/Monad.hs b/library/Morloc/Monad.hs
index 91bebf54..24e020b2 100644
--- a/library/Morloc/Monad.hs
+++ b/library/Morloc/Monad.hs
@@ -37,14 +37,10 @@ module Morloc.Monad
   -- * metadata accessors
   , metaMonomorphicTermTypes
   , metaTermTypes
-  , metaConstraints
   , metaSources
   , metaName
-  , metaProperties
   , metaTypedefs
   , metaGeneralTypedefs
-  , metaMogrifiers
-  , metaUniversalMogrifiers
   -- * handling tree depth
   , incDepth
   , getDepth
@@ -79,7 +75,6 @@ import qualified System.Exit as SE
 import qualified System.Process as SP
 import qualified Morloc.System as MS
 import qualified Data.Map as Map
-import qualified Data.Set as Set
 
 runMorlocMonad ::
      Maybe Path -> Int -> Config -> MorlocMonad a -> IO (MorlocReturn a)
@@ -264,28 +259,6 @@ metaSources i = do
     GMapNoSnd -> throwError . CallTheMonkeys $ "Internal GMap key missing"
     (GMapJust srcs) -> return srcs
 
--- TODO: rename the meta* functions
-
--- | The general constraints as defined in the general type signature. These
--- are not used anywhere yet.
-metaConstraints :: Int -> MorlocMonad [Constraint]
-metaConstraints i = do
-  s <- gets stateSignatures
-  return $ case GMap.lookup i s of
-    (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (econs e)
-    (GMapJust (Polymorphic _ _ e _)) -> Set.toList (econs e)
-    _ -> []
-
--- | Properties are cunrrently not used after Sanno types are created. The only
--- properties that are considered are the pack/unpack properties. Eventually
--- properties will be part of the typeclass system.
-metaProperties :: Int -> MorlocMonad [Property]
-metaProperties i = do
-  s <- gets stateSignatures
-  return $ case GMap.lookup i s of
-    (GMapJust (Monomorphic (TermTypes (Just e) _ _))) -> Set.toList (eprop e)
-    (GMapJust (Polymorphic _ _ e _)) -> Set.toList (eprop e)
-    _ -> []
 
 ----- TODO: metaName should no longer be required - remove
 -- | The name of a morloc composition. These names are stored in the monad
@@ -307,18 +280,6 @@ metaProperties i = do
 metaName :: Int -> MorlocMonad (Maybe EVar)
 metaName i = gets (Map.lookup i . stateName)
 
-metaMogrifiers :: Int -> Lang -> MorlocMonad (Map.Map Property [(TypeU, Source)])
-metaMogrifiers i lang = do
-  p <- gets stateInnerMogrifiers
-  return $ case GMap.lookup i p of
-    (GMapJust p') -> Map.map (filter (\(_, src) -> srcLang src == lang)) p'
-    _ -> Map.empty
-
-metaUniversalMogrifiers :: Lang -> MorlocMonad (Map.Map Property [(TypeU, Source)])
-metaUniversalMogrifiers lang = do
-  p <- gets stateUniversalInnerMogrifiers
-  return $ Map.map (filter (\(_, src) -> srcLang src == lang)) p
-
 -- | This is currently only used in the C++ translator.
 -- FIXME: should a term be allowed to have multiple type definitions within a language?
 metaTypedefs :: Int -> Lang -> MorlocMonad (Map.Map TVar ([TVar], TypeU, Bool))
diff --git a/library/Morloc/Namespace.hs b/library/Morloc/Namespace.hs
index 40e90c1e..89c3de9c 100644
--- a/library/Morloc/Namespace.hs
+++ b/library/Morloc/Namespace.hs
@@ -33,7 +33,7 @@ module Morloc.Namespace
   , MVar(..)
   , EVar(..)
   , TVar(..)
-  , Typeclass(..)
+  , ClassName(..)
   , CVar(..)
   , Key(..)
   , Label(..)
@@ -199,7 +199,7 @@ type MorlocMonadGen c e l s a
 
 type MorlocReturn a = ((Either MorlocError a, [Text]), MorlocState)
 
-data SignatureSet = Monomorphic TermTypes | Polymorphic Typeclass EVar EType [TermTypes]
+data SignatureSet = Monomorphic TermTypes | Polymorphic ClassName EVar EType [TermTypes]
   deriving(Show)
 
 
@@ -213,6 +213,7 @@ data MorlocState = MorlocState
   , stateDepth :: Int
   -- ^ store depth in the AnnoS tree in the frontend and backend typecheckers
   , stateSignatures :: GMap Int Int SignatureSet
+  , stateTypeclasses :: Map.Map EVar (ClassName, [TVar], EType, [TermTypes])
   , stateConcreteTypedefs :: GMap Int MVar (Map Lang Scope)
   -- ^ stores type functions that are in scope for a given module and language
   , stateGeneralTypedefs  :: GMap Int MVar           Scope
@@ -225,8 +226,6 @@ data MorlocState = MorlocState
   -- ^ store the general typedefs pooled across all modules -- for the truly desparate
   , stateUniversalConcreteTypedefs :: Map Lang Scope
   -- ^ store the concrete typedefs pooled across all modules -- for the truly desparate
-  , stateInnerMogrifiers :: GMap Int MVar (Map Property [(TypeU, Source)])
-  , stateUniversalInnerMogrifiers :: Map Property [(TypeU, Source)]
   , stateSources :: GMap Int MVar [Source]
   , stateAnnotations :: Map Int [TypeU]
   -- ^ Stores non-top-level annotations.
@@ -329,8 +328,8 @@ data ExprI = ExprI Int Expr
 data Expr
   = ModE MVar [ExprI]
   -- ^ the toplevel expression in a module
-  | ClsE Typeclass [TVar] [Signature]
-  | IstE Typeclass [TypeU] [ExprI]
+  | ClsE ClassName [TVar] [Signature]
+  | IstE ClassName [TypeU] [ExprI]
   | TypE (Maybe (Lang, Bool)) TVar [TVar] TypeU
   -- ^ a type definition
   --   1. the language, Nothing is general
@@ -477,7 +476,7 @@ newtype EVar = EV { unEVar :: Text } deriving (Show, Eq, Ord)
 -- A type general name
 newtype TVar = TV { unTVar :: Text } deriving (Show, Eq, Ord)
 
-newtype Typeclass = Typeclass { unTypeclass :: Text } deriving (Show, Eq, Ord)
+newtype ClassName = ClassName { unClassName :: Text } deriving (Show, Eq, Ord)
 
 -- A concrete type name
 newtype CVar = CV { unCVar :: Text } deriving (Show, Eq, Ord)
@@ -540,7 +539,7 @@ newtype One a = One { unOne :: a }
 newtype Many a = Many { unMany :: [a] }
   deriving (Show)
 
-data ManyPoly a = MonomorphicExpr (Maybe EType) [a] | PolymorphicExpr Typeclass EVar EType [(EType, [a])]
+data ManyPoly a = MonomorphicExpr (Maybe EType) [a] | PolymorphicExpr ClassName EVar EType [(EType, [a])]
   deriving(Show, Eq, Ord)
 
 data Or a b = L a | R b | LR a b
@@ -595,12 +594,7 @@ data EType =
     }
   deriving (Show, Eq, Ord)
 
-
-data Property
-  = Pack -- data structure to JSON
-  | Unpack -- JSON to data structure
-  | Cast -- casts from type A to B
-  | GeneralProperty [Text]
+newtype Property = Property [Text]
   deriving (Show, Eq, Ord)
 
 -- | Eventually, Constraint should be a richer type, but for they are left as
@@ -698,6 +692,11 @@ data MorlocError
   | IllegalConcreteAnnotation
   -- type synthesis errors
   | CannotSynthesizeConcreteType MVar Source TypeU [Text]
+  -- typeclass errors
+  | MissingTypeclassDefinition ClassName EVar
+  | ConflictingClasses ClassName ClassName EVar
+  | InstanceSizeMismatch ClassName [TVar] [TypeU]
+  | IllegalExpressionInInstance ClassName [TypeU] Expr
 
 
 
@@ -804,12 +803,11 @@ instance Defaultable MorlocState where
     , stateCounter = -1
     , stateDepth = 0
     , stateSignatures = GMap Map.empty Map.empty
+    , stateTypeclasses = Map.empty
     , stateConcreteTypedefs = GMap Map.empty Map.empty
     , stateGeneralTypedefs = GMap Map.empty Map.empty
     , stateUniversalConcreteTypedefs = Map.empty
     , stateUniversalGeneralTypedefs = Map.empty
-    , stateInnerMogrifiers = GMap Map.empty Map.empty
-    , stateUniversalInnerMogrifiers = Map.empty
     , stateSources = GMap Map.empty Map.empty
     , stateAnnotations = Map.empty
     , stateOutfile = Nothing
@@ -984,6 +982,10 @@ isSubtypeOf t1 t2 = case P.compare t1 t2 of
 equivalent :: TypeU -> TypeU -> Bool
 equivalent t1 t2 = isSubtypeOf t1 t2 && isSubtypeOf t2 t1
 
+-- | find the most specific subtypes
+mostSpecificSubtypes :: TypeU -> [TypeU] -> [TypeU]
+mostSpecificSubtypes t ts = mostSpecific $ filter (`isSubtypeOf` t) ts
+
 -- | find all types that are not greater than any other type
 mostGeneral :: [TypeU] -> [TypeU]
 mostGeneral = P.minima
@@ -992,10 +994,6 @@ mostGeneral = P.minima
 mostSpecific :: [TypeU] -> [TypeU]
 mostSpecific = P.maxima
 
--- | find the most specific subtypes
-mostSpecificSubtypes :: TypeU -> [TypeU] -> [TypeU]
-mostSpecificSubtypes t ts = mostSpecific $ filter (`isSubtypeOf` t) ts
-
 
 ----- Pretty instances -------------------------------------------------------
 
@@ -1020,7 +1018,7 @@ instance Pretty Type where
 instance Pretty TypeU where
   pretty (FunU [] t) = "() -> " <> prettyTypeU t
   pretty (FunU ts t) = hsep $ punctuate " ->" (map prettyTypeU (ts <> [t]))
-  pretty (ForallU _ t) = pretty t
+  pretty (ForallU v t) = "forall" <+> pretty v <+> "." <+> pretty t
   pretty t = prettyTypeU t
 
 prettyTypeU :: TypeU -> Doc ann
@@ -1029,7 +1027,7 @@ prettyTypeU (ExistU v ts rs)
   = angles $ pretty v
   <+> list (map prettyTypeU ts)
   <+> list (map ((\(x,y) -> tupled [x, y]) . bimap pretty prettyTypeU) rs)
-prettyTypeU (ForallU _ t) = prettyTypeU t
+prettyTypeU (ForallU v t) = "forall" <+> pretty v <+> "." <+> prettyTypeU t
 prettyTypeU (VarU v) = pretty v
 prettyTypeU (FunU [] t) = parens $ "() -> " <> prettyTypeU t
 prettyTypeU (FunU ts t) = encloseSep "(" ")" " -> " (map prettyTypeU (ts <> [t]))
@@ -1054,10 +1052,7 @@ instance Pretty EType where
       csStr xs = " |" <+> hsep (punctuate semi (map pretty xs))
 
 instance Pretty Property where
-  pretty Pack = "pack"
-  pretty Unpack = "unpack"
-  pretty Cast = "cast"
-  pretty (GeneralProperty ts) = hsep (map pretty ts)
+  pretty (Property ts) = hsep (map pretty ts)
 
 instance Pretty Constraint where
   pretty (Con x) = pretty x
@@ -1072,8 +1067,8 @@ instance Pretty MVar where
 instance Pretty TVar where
   pretty (TV v) = pretty v
 
-instance Pretty Typeclass where
-  pretty = pretty . unTypeclass
+instance Pretty ClassName where
+  pretty = pretty . unClassName
 
 instance Pretty Key where
   pretty (Key v) = pretty v
@@ -1312,6 +1307,12 @@ instance Pretty MorlocError where
     = pretty (CannotSynthesizeConcreteType m src t []) <> "\n" <>
       "  Cannot resolve concrete types for these general types:" <+> list (map pretty vs) <> "\n" <>
       "  Are you missing type alias imports?"
+  pretty (MissingTypeclassDefinition cls v) = "No definition found in typeclass" <+> dquotes (pretty cls) <+> "for term" <+> dquotes (pretty v) 
+  pretty (ConflictingClasses cls1 cls2 v) = "Conflicting typeclasses for" <+> pretty v <+> "found definitions in both" <+> pretty cls1 <+> "and" <+> pretty cls2
+  pretty (InstanceSizeMismatch cls vs ts) = "For class" <+> pretty cls <+> "expected" <+> pretty (length vs) <+> "parameters" <+> tupled (map pretty vs)
+    <+> "but found" <+> pretty (length ts) <+> tupled (map pretty ts)
+  pretty (IllegalExpressionInInstance cls ts e) = "Illegal expression found in" <+> pretty cls <+> "instance for" <> "\n   " <> align (hsep (map pretty ts)) <> "\n   " <> pretty e
+  
 
 instance Pretty TypeError where
   pretty (SubtypeError t1 t2 msg)
diff --git a/library/Morloc/Typecheck/Internal.hs b/library/Morloc/Typecheck/Internal.hs
index e4364cc1..96a47cda 100644
--- a/library/Morloc/Typecheck/Internal.hs
+++ b/library/Morloc/Typecheck/Internal.hs
@@ -40,6 +40,8 @@ module Morloc.Typecheck.Internal
   , toExistential
   -- * subtyping
   , subtype
+  , isSubtypeOf2
+  , equivalent2
   -- * debugging
   , seeGamma
   -- debugging
@@ -135,6 +137,14 @@ instance GammaIndexLike TVar where
 (++>) g xs = g {gammaContext = map index (reverse xs) <> gammaContext g }
 
 
+isSubtypeOf2 :: TypeU -> TypeU -> Bool
+isSubtypeOf2 a b = case subtype a b (Gamma 0 []) of
+  (Left _) -> False
+  (Right _) -> True
+
+equivalent2 :: TypeU -> TypeU -> Bool
+equivalent2 t1 t2 = isSubtypeOf2 t1 t2 && isSubtypeOf2 t2 t1
+
 -- | type 1 is more polymorphic than type 2 (Dunfield Figure 9)
 subtype :: TypeU -> TypeU -> Gamma -> Either TypeError Gamma
 
diff --git a/test-suite/Main.hs b/test-suite/Main.hs
index 45bb1180..25799894 100644
--- a/test-suite/Main.hs
+++ b/test-suite/Main.hs
@@ -25,6 +25,8 @@ main = do
 
       , golden "typeclasses-1" "typeclasses-1"
       , golden "typeclasses-2" "typeclasses-2"
+      , golden "typeclasses-3" "typeclasses-3"
+      , golden "typeclasses-4" "typeclasses-4"
 
       , golden "string-encoding" "string-encoding"
 
diff --git a/test-suite/golden-tests/import-2/localmap/main.loc b/test-suite/golden-tests/import-2/localmap/main.loc
index c64c9a3a..323949d7 100644
--- a/test-suite/golden-tests/import-2/localmap/main.loc
+++ b/test-suite/golden-tests/import-2/localmap/main.loc
@@ -12,8 +12,14 @@ type py => (Map key val) = "dict" key val
 type py => (Tuple2 a b) = "tuple" a b
 type py => (List a) = "list" a
 
--- These do not need to be exported (and indeed should not be)
-packMap :: pack => ([key],[val]) -> Map key val
-unpackMap :: unpack => Map key val -> ([key],[val])
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
+
+instance Packable ([key],[val]) (Map key val) where
+  source py from "main.py"
+   ( "morloc_packMap" as pack
+   , "morloc_unpackMap" as unpack
+   )
 
 person :: Str -> Map Str Int
diff --git a/test-suite/golden-tests/packer-definitions-1/main.loc b/test-suite/golden-tests/packer-definitions-1/main.loc
index 8601418f..92d46593 100644
--- a/test-suite/golden-tests/packer-definitions-1/main.loc
+++ b/test-suite/golden-tests/packer-definitions-1/main.loc
@@ -11,5 +11,13 @@ foo :: Str -> JsonObj
 type Py => Str = "str"
 type Py => JsonObj = "dict"
 
-packJsonObj   :: pack   => Str -> JsonObj
-unpackJsonObj :: unpack => JsonObj -> Str
+
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
+
+instance Packable (Str) JsonObj where
+  source Py from "foo.py"
+    ( "packJsonObj" as pack
+    , "unpackJsonObj" as unpack
+    )
diff --git a/test-suite/golden-tests/packer-definitions-2/lib/json/main.loc b/test-suite/golden-tests/packer-definitions-2/lib/json/main.loc
index 5e729ec8..2126b0d2 100644
--- a/test-suite/golden-tests/packer-definitions-2/lib/json/main.loc
+++ b/test-suite/golden-tests/packer-definitions-2/lib/json/main.loc
@@ -1,12 +1,14 @@
 module lib.json (JsonObj, Str)
 
-source Py from "json.py"
-  ( "packJsonObj" as packJsonObj
-  , "unpackJsonObj" as unpackJsonObj
-  )
-
 type Py => Str = "str"
 type Py => JsonObj = "dict"
 
-packJsonObj   :: pack   => Str -> JsonObj
-unpackJsonObj :: unpack => JsonObj -> Str
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
+
+instance Packable (Str) JsonObj where
+  source Py from "json.py"
+    ( "packJsonObj" as pack
+    , "unpackJsonObj" as unpack
+    )
diff --git a/test-suite/golden-tests/packer-definitions-5/main.loc b/test-suite/golden-tests/packer-definitions-5/main.loc
index b4be83fe..5c6de397 100644
--- a/test-suite/golden-tests/packer-definitions-5/main.loc
+++ b/test-suite/golden-tests/packer-definitions-5/main.loc
@@ -12,23 +12,25 @@ type Py => Tuple2 a b = "tuple" a b
 type Py => Str = "str"
 type Py => Int = "int"
 
-source Cpp from "map.hpp"
-  ( "morloc_packMap" as packMapCpp
-  , "morloc_unpackMap" as unpackMapCpp
-  , "insert"
-  )
-packMapCpp :: pack => ([key],[val]) -> Map key val
-unpackMapCpp :: unpack => Map key val -> ([key],[val])
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
 
+instance Packable ([key],[val]) (Map key val) where
+  source Py from "map.py"
+    ( "packMap" as pack
+    , "unpackMap" as unpack
+    )
+
+  source Cpp from "map.hpp"
+    ( "morloc_packMap" as pack
+    , "morloc_unpackMap" as unpack
+    )
+
+source Cpp from "map.hpp" ("insert")
 insert :: Map Str b -> Str -> b -> Map Str b
 
-source Py from "map.py"
-  ( "packMap" as packMapPy
-  , "unpackMap" as unpackMapPy
-  , "singleton"
-  )
-packMapPy   :: pack   => ([Str],[b]) -> Map Str b
-unpackMapPy :: unpack => Map Str b -> ([Str],[b])
+source Py from "map.py" ("singleton")
 singleton :: Str -> a -> Map Str a
 
 foo :: Int -> Int -> Map Str Int
diff --git a/test-suite/golden-tests/records-2/foo.loc b/test-suite/golden-tests/records-2/foo.loc
index 5bfc1113..cebaec6e 100644
--- a/test-suite/golden-tests/records-2/foo.loc
+++ b/test-suite/golden-tests/records-2/foo.loc
@@ -6,10 +6,15 @@ type Py => (List a) = "list" a
 type Py => (Map a b) = "dict" a b
 type Py => (Tuple2 a b) = "tuple" a b
 
-packMap      :: pack   => [(a,b)] -> Map a b
-unpackMap    :: unpack => Map a b -> [(a,b)]
 
-source Py from "foo.py" ("packMap", "unpackMap", "push", "makeMap")
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
+
+instance Packable [(key,val)] (Map key val) where
+  source Py from "foo.py" ("packMap" as pack, "unpackMap" as unpack)
+
+source Py from "foo.py" ("push", "makeMap")
 
 push :: (n -> n')
      -> (n' -> e -> n -> (e', n'))
diff --git a/test-suite/golden-tests/serial-form-8-r/Makefile b/test-suite/golden-tests/serial-form-8-r/Makefile
index a3aad3d9..716f5688 100644
--- a/test-suite/golden-tests/serial-form-8-r/Makefile
+++ b/test-suite/golden-tests/serial-form-8-r/Makefile
@@ -1,7 +1,7 @@
 all:
 	rm -f obs.txt
 	morloc make -v foo.loc > log
-	./nexus.py foo '[["a","b"],[[[3,4],[2.48,1.2]],[[1,2],[1.2,2.48]]]]' | sed 's/ //g' > obs.txt
+	./nexus.py foo '[["a","b"],[[["3","4"],[2.48,1.2]],[["1","2"],[1.2,2.48]]]]' | sed 's/ //g' > obs.txt
 
 clean:
 	rm -f nexus* pool*
diff --git a/test-suite/golden-tests/serial-form-8-r/exp.txt b/test-suite/golden-tests/serial-form-8-r/exp.txt
index 4fb3a073..d0158ff3 100644
--- a/test-suite/golden-tests/serial-form-8-r/exp.txt
+++ b/test-suite/golden-tests/serial-form-8-r/exp.txt
@@ -1 +1 @@
-[["a","b"],[[[3,4],[2.48,1.2]],[[1,2],[1.2,2.48]]]]
+[["a","b"],[[["3","4"],[2.48,1.2]],[["1","2"],[1.2,2.48]]]]
diff --git a/test-suite/golden-tests/serial-form-8-r/foo.loc b/test-suite/golden-tests/serial-form-8-r/foo.loc
index b7129817..45ab63d1 100644
--- a/test-suite/golden-tests/serial-form-8-r/foo.loc
+++ b/test-suite/golden-tests/serial-form-8-r/foo.loc
@@ -1,10 +1,10 @@
 module main (foo)
 
-import conventions (Str, Int, Real, Tuple2, List)
+import conventions (Str, Real, Tuple2, List)
 import rbase (id, Map)
 
 -- This function returns the input, but passes it though a language-specific id
 -- function, which forces deserialization and then serialization.
-foo :: Map Str (Map Int Real) -> Map Str (Map Int Real)
+foo :: Map Str (Map Str Real) -> Map Str (Map Str Real)
 
 foo xs = id xs
diff --git a/test-suite/golden-tests/type-identities-c/foo.loc b/test-suite/golden-tests/type-identities-c/foo.loc
index d3fa4f8f..01113241 100644
--- a/test-suite/golden-tests/type-identities-c/foo.loc
+++ b/test-suite/golden-tests/type-identities-c/foo.loc
@@ -2,22 +2,25 @@ module main (foo)
 
 import cppbase (id)
 
-source Cpp from "types.h"
-  ( "packSizeT"
-  , "unpackSizeT"
-  , "packLong"
-  , "unpackLong"
-  )
+class Packable a b where
+  pack :: a -> b
+  unpack :: b -> a
+
+instance Packable (Int) SizeT where
+  source Cpp from "types.h"
+    ( "packSizeT" as pack
+    , "unpackSizeT" as unpack
+    )
+
+instance Packable (Int) Long where
+  source Cpp from "types.h"
+    ( "packLong" as pack
+    , "unpackLong" as unpack
+    )
 
 type Cpp => SizeT = "size_t" 
 type Cpp => Long = "int64_t" 
 type Cpp => Int = "int"
 
-packSizeT   :: pack   => Int -> SizeT
-unpackSizeT :: unpack => SizeT -> Int
-
-packLong   :: pack   => Int -> Long
-unpackLong :: unpack => Long -> Int
-
 foo :: (SizeT, Long) -> (SizeT, Long)
 foo x = id x
diff --git a/test-suite/golden-tests/typeclasses-3/Makefile b/test-suite/golden-tests/typeclasses-3/Makefile
new file mode 100644
index 00000000..d50da5fa
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-3/Makefile
@@ -0,0 +1,8 @@
+all:
+	rm -f obs.txt
+	morloc make -v main.loc > log
+	./nexus.py foo '["a","b"]' > obs.txt
+	./nexus.py bar '[6,5]' >> obs.txt
+
+clean:
+	rm -f nexus* pool*
diff --git a/test-suite/golden-tests/typeclasses-3/exp.txt b/test-suite/golden-tests/typeclasses-3/exp.txt
new file mode 100644
index 00000000..06542ed3
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-3/exp.txt
@@ -0,0 +1,2 @@
+"['a', 'b']"
+2
diff --git a/test-suite/golden-tests/typeclasses-3/foo.hpp b/test-suite/golden-tests/typeclasses-3/foo.hpp
new file mode 100644
index 00000000..30f4f978
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-3/foo.hpp
@@ -0,0 +1,18 @@
+#ifndef __FOO_HPP__
+#define __FOO_HPP__
+
+#include <string>
+
+int addInt(int x, int y){
+  return (x + y);
+}
+
+double addReal(double x, double y){
+  return (x + y);
+}
+
+std::string addStr(std::string x, std::string y){
+  return (x + y);
+}
+
+#endif
diff --git a/test-suite/golden-tests/typeclasses-3/foo.py b/test-suite/golden-tests/typeclasses-3/foo.py
new file mode 100644
index 00000000..3ab89f24
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-3/foo.py
@@ -0,0 +1,8 @@
+def addInt(x, y):
+    return x + y
+
+def addReal(x, y):
+    return x + y
+
+def addStr(x, y):
+    return x + y
diff --git a/test-suite/golden-tests/typeclasses-3/main.loc b/test-suite/golden-tests/typeclasses-3/main.loc
new file mode 100644
index 00000000..667dee0e
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-3/main.loc
@@ -0,0 +1,23 @@
+module main (foo, bar)
+
+type Py => Int = "int"
+type Py => Real = "float"
+type Py => Str = "str"
+type Py => (List a) = "list" a
+
+
+class Summarizable a b where
+  summarize :: a -> b
+
+instance Summarizable [a] Str where
+  source Py ("str" as summarize)
+
+instance Summarizable [a] Int where
+  source Py ("len" as summarize)
+
+
+foo :: [Int] -> Str
+foo x = summarize x
+
+bar :: [Int] -> Int
+bar x = summarize x
diff --git a/test-suite/golden-tests/typeclasses-4/Makefile b/test-suite/golden-tests/typeclasses-4/Makefile
new file mode 100644
index 00000000..5ce8a266
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-4/Makefile
@@ -0,0 +1,7 @@
+all:
+	rm -f obs.txt
+	morloc make -v main.loc > log
+	./nexus.py foo '["a","bad"]' > obs.txt
+
+clean:
+	rm -rf nexus* pool* __pycache__
diff --git a/test-suite/golden-tests/typeclasses-4/exp.txt b/test-suite/golden-tests/typeclasses-4/exp.txt
new file mode 100644
index 00000000..dcb3fccb
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-4/exp.txt
@@ -0,0 +1 @@
+[["a","bad"],[1,3]]
diff --git a/test-suite/golden-tests/typeclasses-4/foo.py b/test-suite/golden-tests/typeclasses-4/foo.py
new file mode 100644
index 00000000..fe9e9317
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-4/foo.py
@@ -0,0 +1,15 @@
+#  class Reversible ([a],[b]) [(a,b)] where
+def forward(x):
+    return list(zip(x[0], x[1]))
+
+def backward(xys):
+    xs = []
+    ys = []
+    for (x,y) in xys:
+        xs.append(x)
+        ys.append(y)
+    return (xs, ys)
+
+#  addLen :: Str -> (Str, Int)
+def addLen(x):
+    return (x, len(x))
diff --git a/test-suite/golden-tests/typeclasses-4/main.loc b/test-suite/golden-tests/typeclasses-4/main.loc
new file mode 100644
index 00000000..0388570b
--- /dev/null
+++ b/test-suite/golden-tests/typeclasses-4/main.loc
@@ -0,0 +1,22 @@
+module main (foo)
+
+type Py => Int = "int"
+type Py => Str = "str"
+type Py => (List a) = "list" a
+type Py => Tuple2 a b = "tuple" a b
+
+
+class Reversible a b where
+  forward :: a -> b
+  backward :: b -> a
+
+instance Reversible ([a],[b]) [(a,b)] where
+  source Py from "foo.py" ("forward", "backward")
+
+
+source Py from "foo.py" ("addLen", "map")
+addLen :: Str -> (Str, Int)
+map :: (a -> b) -> [a] -> [b]
+
+foo :: [Str] -> ([Str],[Int])
+foo = backward . map addLen

From c26f1f1ae837da5bd86390272321f7ae94d63ab6 Mon Sep 17 00:00:00 2001
From: Zebulun Arendsee <zbwrnz@gmail.com>
Date: Thu, 8 Feb 2024 22:28:48 -0500
Subject: [PATCH 14/14] Update versions and changelog

---
 ChangeLog.md     | 14 +++++++++++---
 executable/UI.hs |  2 +-
 package.yaml     |  2 +-
 3 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 6c0f076b..49108ef9 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -19,7 +19,6 @@ handling for several very different languages (proofs-of-concept).
 -------------------
  - [ ] add Haskell support
 
- - [ ] typeclasses
  - [ ] algebraic types
  - [ ] pattern matching
  - [ ] constraint checking
@@ -58,10 +57,19 @@ handling for several very different languages (proofs-of-concept).
  - [ ] Ensure github actions passes
 
 
-0.44.0 [2024.02.xx]
+0.44.0 [2024.02.08]
 -------------------
 
-Ad hoc polymorphism with type-classes
+Add support for ad hoc polymorphism.
+  * Support sources and declarations in classes 
+  * Support multiple parameters
+  * Support overlapping instances
+  * Packers are now implemented through the `Packable` typeclass
+
+Some missing features:
+  * No support typeclass constraints in the type signatures.
+  * No support for parameterized class variables
+  * No support for polymorphic recursion (does anyone want that?)
 
 0.43.0 [2024.01.14]
 -------------------
diff --git a/executable/UI.hs b/executable/UI.hs
index 4b757c68..1f42688c 100644
--- a/executable/UI.hs
+++ b/executable/UI.hs
@@ -13,7 +13,7 @@ opts :: ParserInfo CliCommand
 opts = info (cliParser <**> helper)
   (    fullDesc
     <> progDesc "call 'morloc make -h', 'morloc install -h', etc for details"
-    <> header "morloc v0.43.0"  -- FIXME: HARDCODED VERSION NUMBER!!!
+    <> header "morloc v0.44.0"  -- FIXME: HARDCODED VERSION NUMBER!!!
   )
 
 
diff --git a/package.yaml b/package.yaml
index b4b69573..3bd7e2f2 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:             morloc
-version:          0.43.0
+version:          0.44.0
 homepage:         https://github.com/morloc-project/morloc
 synopsis:         A multi-lingual, typed, workflow language
 description:      See GitHub README <https://github.com/morloc-project/morloc#readme>