added debug info

This commit is contained in:
sebastianselander 2023-03-24 18:26:59 +01:00
parent 23c174607b
commit b4cae11c0d
2 changed files with 31 additions and 24 deletions

View file

@ -3,6 +3,7 @@
module Main where
import Codegen.Codegen (generateCode)
import Data.Bool (bool)
import GHC.IO.Handle.Text (hPutStrLn)
import Grammar.ErrM (Err)
import Grammar.Par (myLexer, pProgram)
@ -15,10 +16,13 @@ import Data.List.Extra (isSuffixOf)
import Compiler (optimize)
import Renamer.Renamer (rename)
import System.Directory (createDirectory, doesPathExist,
import System.Directory (
createDirectory,
doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory)
setCurrentDirectory,
)
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.IO (stderr)
@ -38,15 +42,15 @@ main' debug s = do
printToErr "-- Parse Tree -- "
parsed <- fromSyntaxErr . pProgram $ myLexer file
printToErr $ printTree parsed
bool (printToErr $ printTree parsed) (printToErr $ printTree parsed) debug
printToErr "\n-- Renamer --"
renamed <- fromRenamerErr . rename $ parsed
printToErr $ printTree renamed
bool (printToErr $ printTree renamed) (printToErr $ show renamed) debug
printToErr "\n-- TypeChecker --"
typechecked <- fromTypeCheckerErr $ typecheck renamed
printToErr $ printTree typechecked
bool (printToErr $ printTree typechecked) (printToErr $ show typechecked) debug
-- printToErr "\n-- Lambda Lifter --"
-- let lifted = lambdaLift typechecked

View file

@ -129,7 +129,7 @@ checkBind err@(Bind name args e) = do
sub <- bindErr (unify t lambdaT) err
let newT = apply sub t
insertSig (coerce name) (Just newT)
return $ T.Bind (coerce name, newT) (map coerce args) e
return $ T.Bind (apply sub (coerce name, newT)) (map coerce args) e
_ -> do
insertSig (coerce name) (Just lambdaT)
return (T.Bind (coerce name, lambdaT) (map coerce args) e) -- (apply s e)
@ -481,6 +481,9 @@ instance SubstType T.Pattern where
instance SubstType a => SubstType [a] where
apply s = map (apply s)
instance SubstType T.Id where
apply s (name, t) = (name, apply s t)
-- | Apply substitutions to the environment.
applySt :: Subst -> Infer a -> Infer a
applySt s = local (\st -> st{vars = apply s (vars st)})