hm is compatible

This commit is contained in:
sebastianselander 2023-03-27 16:52:22 +02:00
parent 6e54378327
commit d5ce73beae
4 changed files with 106 additions and 69 deletions

View file

@ -7,21 +7,29 @@ import Data.Bool (bool)
import Data.List.Extra (isSuffixOf) import Data.List.Extra (isSuffixOf)
import Data.Maybe (fromJust, isNothing) import Data.Maybe (fromJust, isNothing)
import GHC.IO.Handle.Text (hPutStrLn) import GHC.IO.Handle.Text (hPutStrLn)
import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), import System.Console.GetOpt (
ArgDescr (NoArg, ReqArg),
ArgOrder (RequireOrder), ArgOrder (RequireOrder),
OptDescr (Option), getOpt, OptDescr (Option),
usageInfo) getOpt,
import System.Directory (createDirectory, doesPathExist, usageInfo,
)
import System.Directory (
createDirectory,
doesPathExist,
getDirectoryContents, getDirectoryContents,
removeDirectoryRecursive, removeDirectoryRecursive,
setCurrentDirectory) setCurrentDirectory,
)
import System.Environment (getArgs) import System.Environment (getArgs)
import System.Exit (ExitCode (ExitFailure), import System.Exit (
exitFailure, exitSuccess, ExitCode (ExitFailure),
exitWith) exitFailure,
exitSuccess,
exitWith,
)
import System.IO (stderr) import System.IO (stderr)
import Codegen.Codegen (generateCode) import Codegen.Codegen (generateCode)
import Compiler (compile) import Compiler (compile)
import Grammar.ErrM (Err) import Grammar.ErrM (Err)
@ -59,7 +67,9 @@ flags =
] ]
initOpts :: Options initOpts :: Options
initOpts = Options { help = False initOpts =
Options
{ help = False
, debug = False , debug = False
, typechecker = Nothing , typechecker = Nothing
} }
@ -115,7 +125,7 @@ main' opts s = do
check <- doesPathExist "output" check <- doesPathExist "output"
when check (removeDirectoryRecursive "output") when check (removeDirectoryRecursive "output")
createDirectory "output" createDirectory "output"
when debug $ do when opts.debug $ do
_ <- writeFile "output/llvm.ll" generatedCode _ <- writeFile "output/llvm.ll" generatedCode
debugDotViz debugDotViz

View file

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

4
tests/DoStrings.hs Normal file
View file

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

View file

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