Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Minor changes. Added a comment

Browse source
This commit is contained in:
sebastianselander 2023-02-15 18:10:28 +01:00
parent 7619e36c60
commit b03df17e34
2 changed files with 29 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

37
src/Main.hs
View file

@ -19,20 +19,29 @@ main = getArgs >>= \case
putStrLn "SYNTAX ERROR" putStrLn "SYNTAX ERROR"
putStrLn err putStrLn err
exitFailure exitFailure
Right prg -> case rename prg of Right prg -> do
Left err -> do putStrLn ""
putStrLn "FAILED RENAMING" putStrLn " ----- PARSER ----- "
putStrLn . show $ err putStrLn ""
exitFailure putStrLn . printTree $ prg
Right prg -> case typecheck prg of putStrLn . show $ prg
case rename prg of
Left err -> do Left err -> do
putStrLn "TYPECHECK ERROR" putStrLn "FAILED RENAMING"
putStrLn . show $ err putStrLn . show $ err
exitFailure exitFailure
Right prg -> do Right prg ->do
putStrLn ""
putStrLn " ----- RENAMER ----- "
putStrLn "" putStrLn ""
putStrLn . printTree $ prg putStrLn . printTree $ prg
putStrLn "" case typecheck prg of
putStrLn " ----- ADT ----- " Left err -> do
putStrLn "" putStrLn "TYPECHECK ERROR"
putStrLn $ show prg putStrLn . show $ err
exitFailure
Right prg -> do
putStrLn ""
putStrLn " ----- TYPECHECKER ----- "
putStrLn ""
putStrLn . printTree $ prg

9
src/TypeChecker/TypeChecker.hs
View file

@ -12,6 +12,7 @@ import qualified Data.Map as M
import Grammar.ErrM (Err) import Grammar.ErrM (Err)
import Grammar.Print import Grammar.Print
import Debug.Trace (trace)
import TypeChecker.TypeCheckerIr import TypeChecker.TypeCheckerIr
data Ctx = Ctx { vars :: Map Integer Type data Ctx = Ctx { vars :: Map Integer Type
@ -51,6 +52,7 @@ inferBind (RBind name e) = do
insertSigs name t insertSigs name t
return $ TBind name t e' return $ TBind name t e'
-- This needs to be fixed. Should not separate inference of type and creation of the new data type.
toTExpr :: RExp -> Infer TExp toTExpr :: RExp -> Infer TExp
toTExpr = \case toTExpr = \case
@ -88,7 +90,6 @@ toTExpr = \case
e' <- toTExpr e e' <- toTExpr e
return $ TAbs num name e' t return $ TAbs num name e' t
inferExp :: RExp -> Infer Type inferExp :: RExp -> Infer Type
inferExp = \case inferExp = \case
@ -198,7 +199,7 @@ find = todo
apply :: Type -> Type -> Infer Type apply :: Type -> Type -> Infer Type
apply (TArrow t1 t2) t3 apply (TArrow t1 t2) t3
| t1 == t3 = return t2 | t1 == t3 = return t2
| otherwise = throwError $ TypeMismatch "apply" apply t1 t2 = throwError $ TypeMismatch "apply"
{-# WARNING todo "TODO IN CODE" #-} {-# WARNING todo "TODO IN CODE" #-}
todo :: a todo :: a
@ -219,4 +220,6 @@ data Error
lambda = RAbs 0 "x" (RAdd (RBound 0 "x") (RBound 0 "x")) lambda = RAbs 0 "x" (RAdd (RBound 0 "x") (RBound 0 "x"))
lambda2 = RAbs 0 "x" (RAnn (RBound 0 "x") (TArrow (TMono "Int") (TMono "String"))) lambda2 = RAbs 0 "x" (RAnn (RBound 0 "x") (TArrow (TMono "Int") (TMono "String")))
fn_on_var = RAbs 0 "f" (RAbs 1 "x" (RApp (RBound 0 "f") (RBound 1 "x"))) fn_on_var = RAbs 0 (Ident "f") (RAbs 1 (Ident "x") (RApp (RBound 0 (Ident "f")) (RBound 1 (Ident "x"))))
bind = RBind "test" fn_on_var