(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

@@ -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 =

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

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

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)

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

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 ()