added const body again

This commit is contained in:
sebastianselander 2023-04-28 12:53:29 +02:00
parent e42c775135
commit 072f2206e6

View file

@ -2,37 +2,46 @@
module Main where
import AnnForall (annotateForall)
import Codegen.Codegen (generateCode)
import Compiler (compile)
import Control.Monad (when, (<=<))
import Data.List.Extra (isSuffixOf)
import Data.Maybe (fromJust, isNothing)
import Desugar.Desugar (desugar)
import GHC.IO.Handle.Text (hPutStrLn)
import Grammar.ErrM (Err)
import Grammar.Layout (resolveLayout)
import Grammar.Par (myLexer, pProgram)
import Grammar.Print (Print, printTree)
import LambdaLifter (lambdaLift)
import Monomorphizer.Monomorphizer (monomorphize)
import Renamer.Renamer (rename)
import ReportForall (reportForall)
import System.Console.GetOpt (ArgDescr (NoArg, ReqArg),
ArgOrder (RequireOrder),
OptDescr (Option), getOpt,
usageInfo)
import System.Directory (createDirectory, doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory)
import System.Environment (getArgs)
import System.Exit (ExitCode (ExitFailure),
exitFailure, exitSuccess,
exitWith)
import System.IO (stderr)
import System.Process (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (TypeChecker (Bi, Hm), typecheck)
import AnnForall (annotateForall)
import Codegen.Codegen (generateCode)
import Compiler (compile)
import Control.Monad (when, (<=<))
import Data.List.Extra (isSuffixOf)
import Data.Maybe (fromJust, isNothing)
import Desugar.Desugar (desugar)
import GHC.IO.Handle.Text (hPutStrLn)
import Grammar.ErrM (Err)
import Grammar.Layout (resolveLayout)
import Grammar.Par (myLexer, pProgram)
import Grammar.Print (Print, printTree)
import LambdaLifter (lambdaLift)
import Monomorphizer.Monomorphizer (monomorphize)
import Renamer.Renamer (rename)
import ReportForall (reportForall)
import System.Console.GetOpt (
ArgDescr (NoArg, ReqArg),
ArgOrder (RequireOrder),
OptDescr (Option),
getOpt,
usageInfo,
)
import System.Directory (
createDirectory,
doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory,
)
import System.Environment (getArgs)
import System.Exit (
ExitCode (ExitFailure),
exitFailure,
exitSuccess,
exitWith,
)
import System.IO (stderr)
import System.Process (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (TypeChecker (Bi, Hm), typecheck)
main :: IO ()
main = getArgs >>= parseArgs >>= uncurry main'
@ -79,11 +88,11 @@ chooseTypechecker s options = options{typechecker = tc}
tc = case s of
"hm" -> pure Hm
"bi" -> pure Bi
_ -> Nothing
_ -> Nothing
data Options = Options
{ help :: Bool
, debug :: Bool
{ help :: Bool
, debug :: Bool
, typechecker :: Maybe TypeChecker
}
@ -158,12 +167,14 @@ fromErr :: Err a -> IO a
fromErr = either (\s -> printToErr s >> exitFailure) pure
prelude :: String
prelude = unlines
[ "\n"
, "const : a -> b -> a"
, "data Bool () where"
, " False : Bool ()"
, " True : Bool ()"
, "lt : Int -> Int -> Bool ()"
, "lt x y = const True (x + y)"
]
prelude =
unlines
[ "\n"
, "const : a -> b -> a"
, "const x y = x"
, "data Bool () where"
, " False : Bool ()"
, " True : Bool ()"
, "lt : Int -> Int -> Bool ()"
, "lt x y = const True (x + y)"
]