hm is compatible

src/Main.hs

@@ -7,21 +7,29 @@ import           Data.Bool                   (bool)
 import Data.List.Extra (isSuffixOf)
 import Data.Maybe (fromJust, isNothing)
 import GHC.IO.Handle.Text (hPutStrLn)
-import           System.Console.GetOpt       (ArgDescr (NoArg, ReqArg),
+import System.Console.GetOpt (
+    ArgDescr (NoArg, ReqArg),
     ArgOrder (RequireOrder),
-                                              OptDescr (Option), getOpt,
-                                              usageInfo)
-import           System.Directory            (createDirectory, doesPathExist,
+    OptDescr (Option),
+    getOpt,
+    usageInfo,
+ )
+import System.Directory (
+    createDirectory,
+    doesPathExist,
     getDirectoryContents,
     removeDirectoryRecursive,
-                                              setCurrentDirectory)
+    setCurrentDirectory,
+ )
 import System.Environment (getArgs)
-import           System.Exit                 (ExitCode (ExitFailure),
-                                              exitFailure, exitSuccess,
-                                              exitWith)
+import System.Exit (
+    ExitCode (ExitFailure),
+    exitFailure,
+    exitSuccess,
+    exitWith,
+ )
 import System.IO (stderr)
 
-
 import Codegen.Codegen (generateCode)
 import Compiler (compile)
 import Grammar.ErrM (Err)
@@ -38,7 +46,7 @@ main = getArgs >>= parseArgs >>= uncurry main'
 
 parseArgs :: [String] -> IO (Options, String)
 parseArgs argv = case getOpt RequireOrder flags argv of
-  (os, f:_, [])
+    (os, f : _, [])
         | opts.help || isNothing opts.typechecker -> do
             hPutStrLn stderr (usageInfo header flags)
             exitSuccess
@@ -59,19 +67,21 @@ flags =
     ]
 
 initOpts :: Options
-initOpts = Options { help        = False
+initOpts =
+    Options
+        { help = False
         , debug = False
         , typechecker = Nothing
         }
 
 enableHelp :: Options -> Options
-enableHelp opts = opts { help = True }
+enableHelp opts = opts{help = True}
 
 enableDebug :: Options -> Options
-enableDebug opts = opts { debug = True }
+enableDebug opts = opts{debug = True}
 
 chooseTypechecker :: String -> Options -> Options
-chooseTypechecker s options = options { typechecker = tc }
+chooseTypechecker s options = options{typechecker = tc}
   where
     tc = case s of
         "hm" -> pure Hm
@@ -110,12 +120,12 @@ main' opts s = do
     --
     printToErr "\n -- Compiler --"
     generatedCode <- fromCompilerErr $ generateCode (monomorphize typechecked)
-    --putStrLn generatedCode
+    -- putStrLn generatedCode
 
     check <- doesPathExist "output"
     when check (removeDirectoryRecursive "output")
     createDirectory "output"
-    when debug $ do
+    when opts.debug $ do
         _ <- writeFile "output/llvm.ll" generatedCode
         debugDotViz
 

src/TypeChecker/TypeChecker.hs

@@ -0,0 +1,18 @@
+module TypeChecker.TypeChecker (typecheck, TypeChecker (..)) where
+
+import Control.Monad ((<=<))
+import Grammar.Abs
+import Grammar.ErrM (Err)
+import TypeChecker.RemoveTEVar (RemoveTEVar (rmTEVar))
+import TypeChecker.TypeCheckerBidir qualified as Bi
+import TypeChecker.TypeCheckerHm qualified as Hm
+import TypeChecker.TypeCheckerIr qualified as T
+
+data TypeChecker = Bi | Hm
+
+typecheck :: TypeChecker -> Program -> Err T.Program
+typecheck tc = rmTEVar <=< f
+  where
+    f = case tc of
+        Bi -> Bi.typecheck
+        Hm -> Hm.typecheck

tests/DoStrings.hs

@@ -0,0 +1,4 @@
+module DoStrings where
+
+(>>) str1 str2 = str1 ++ "\n" ++ str2
+(>>=) str1 f = f str1

tests/TestTypeCheckerHm.hs

@@ -1,27 +1,32 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE QualifiedDo #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 module TestTypeCheckerHm (testTypeCheckerHm) where
 
 import Control.Monad ((<=<))
-import qualified DoStrings                 as D
+import DoStrings qualified as D
 import Grammar.Par (myLexer, pProgram)
-import           Prelude                   (Bool (..), Either (..), IO, fmap,
-                                            not, ($), (.))
 import Test.Hspec
+import Prelude (
+    Bool (..),
+    Either (..),
+    IO,
+    fmap,
+    not,
+    ($),
+    (.),
+ )
 
 -- import Test.QuickCheck
 import TypeChecker.TypeCheckerHm (typecheck)
 
-
-
 testTypeCheckerHm = describe "Hillner Milner type checker test" $ do
     ok1
     ok2
     bad1
     bad2
-    -- bad3
 
+-- bad3
 
 ok1 =
     specify "Basic polymorphism with multiple type variables" $