From c4477d3df4bb263e86fce271285949d669e05538 Mon Sep 17 00:00:00 2001
From: sebastianselander <sebastian.selander@gmail.com>
Date: Thu, 30 Mar 2023 11:38:06 +0200
Subject: [PATCH] moved some funcs to aux, added a universal definition of int
 and char, updated usages in both tcs

---
 src/Auxiliary.hs                    | 22 +++++++++++++++++++++-
 src/TypeChecker/TypeCheckerBidir.hs |  4 ++--
 src/TypeChecker/TypeCheckerHm.hs    | 22 ++--------------------
 3 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/src/Auxiliary.hs b/src/Auxiliary.hs
index fb0b8cb..0c9f012 100644
--- a/src/Auxiliary.hs
+++ b/src/Auxiliary.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Auxiliary (module Auxiliary) where
 
 import Control.Monad.Error.Class (liftEither)
 import Control.Monad.Except (MonadError)
 import Data.Either.Combinators (maybeToRight)
-import TypeChecker.TypeCheckerIr (Type (TFun))
+import Data.List (foldl')
+import Grammar.Abs
 import Prelude hiding ((>>), (>>=))
 
 (>>) a b = a ++ " " ++ b
@@ -26,3 +28,21 @@ mapAccumM f = go
             (acc', x') <- f acc x
             (acc'', xs') <- go acc' xs
             pure (acc'', x' : xs')
+
+unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])
+unzip4 =
+    foldl'
+        ( \(as, bs, cs, ds) (a, b, c, d) ->
+            (as ++ [a], bs ++ [b], cs ++ [c], ds ++ [d])
+        )
+        ([], [], [], [])
+
+litType :: Lit -> Type
+litType (LInt _) = int
+litType (LChar _) = char
+
+int = TLit "Int"
+char = TLit "Char"
+
+tupSequence :: Monad m => (m a, b) -> m (a, b)
+tupSequence (ma, b) = (,b) <$> ma
diff --git a/src/TypeChecker/TypeCheckerBidir.hs b/src/TypeChecker/TypeCheckerBidir.hs
index 53a942d..031396d 100644
--- a/src/TypeChecker/TypeCheckerBidir.hs
+++ b/src/TypeChecker/TypeCheckerBidir.hs
@@ -6,7 +6,7 @@
 
 module TypeChecker.TypeCheckerBidir (typecheck, getVars) where
 
-import           Auxiliary                 (maybeToRightM, snoc)
+import           Auxiliary                 (maybeToRightM, snoc, int, char)
 import           Control.Applicative       (Alternative, Applicative (liftA2),
                                             (<|>))
 import           Control.Monad.Except      (ExceptT, MonadError (throwError),
@@ -484,7 +484,7 @@ infer = \case
     --  Γ ⊢ e₁ + e₂ ↓ Int ⊣ Δ
     EAdd e1 e2 -> do
         cxt <- get
-        let t = TLit "Int"
+        let t = int
         e1' <- check e1 t
         put cxt
         e2' <- check e2 t
diff --git a/src/TypeChecker/TypeCheckerHm.hs b/src/TypeChecker/TypeCheckerHm.hs
index f0ae924..11cb94e 100644
--- a/src/TypeChecker/TypeCheckerHm.hs
+++ b/src/TypeChecker/TypeCheckerHm.hs
@@ -6,7 +6,7 @@
 -- | A module for type checking and inference using algorithm W, Hindley-Milner
 module TypeChecker.TypeCheckerHm where
 
-import Auxiliary (maybeToRightM)
+import Auxiliary (int, litType, maybeToRightM, tupSequence, unzip4)
 import Auxiliary qualified as Aux
 import Control.Monad.Except
 import Control.Monad.Identity (Identity, runIdentity)
@@ -706,9 +706,6 @@ solveUndecidable = do
             )
     composeAll <$> mapM (uncurry unify) ys
 
-tupSequence :: Monad m => (m a, b) -> m (a, b)
-tupSequence (ma, b) = (,b) <$> ma
-
 getOriginal :: T.Ident -> T.Ident
 getOriginal (T.Ident i) = coerce $ takeWhile (/= delim) $ drop 1 i
 
@@ -725,13 +722,6 @@ typeLength :: Type -> Int
 typeLength (TFun _ b) = 1 + typeLength b
 typeLength _ = 1
 
-litType :: Lit -> Type
-litType (LInt _) = int
-litType (LChar _) = char
-
-int = TLit "Int"
-char = TLit "Char"
-
 {- | Catch an error if possible and add the given
 expression as addition to the error message
 -}
@@ -794,14 +784,6 @@ dataErr ma d =
                 else throwError (err{catchable = False})
         )
 
-unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])
-unzip4 =
-    foldl'
-        ( \(as, bs, cs, ds) (a, b, c, d) ->
-            (as ++ [a], bs ++ [b], cs ++ [c], ds ++ [d])
-        )
-        ([], [], [], [])
-
 initCtx = Ctx mempty
 initEnv = Env 0 'a' mempty mempty mempty "" mempty mempty mempty
 
@@ -816,7 +798,7 @@ run' e c =
         . flip evalStateT e
         . runInfer
 
-data Ctx = Ctx {vars :: Map T.Ident Type}
+newtype Ctx = Ctx {vars :: Map T.Ident Type}
     deriving (Show)
 
 data Env = Env