X-Git-Url: https://ruin.nu/git/?p=proglang.git;a=blobdiff_plain;f=Typecheck.hs;h=70aad706a88cfc5b38a1863744ccce563772e490;hp=a78f8f02c6a51d5d6d643d01ee8a4232f4223dab;hb=d553df8dfdffca78342d6fae142ceded9cd64415;hpb=565fbd61dca527c23888e08783d0d91cee458524

diff --git a/Typecheck.hs b/Typecheck.hs
index a78f8f0..70aad70 100644
--- a/Typecheck.hs
+++ b/Typecheck.hs
@@ -56,34 +56,37 @@ findVariable :: (MonadState Types m) => Ident -> Types -> m Type
 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
 
+pushAndPop :: (MonadState Types m) => m a -> m ()
+pushAndPop s = do
+	modify (empty:)
+	s
+	modify tail
+
 typeCheckStm :: (MonadState Types m) => Stm -> m ()
 typeCheckStm SNoop = return ()
 typeCheckStm (SExp e) = do 
 	typeCheckExp e
 	return ()
-typeCheckStm (SBlock ss) = do 
-	modify (empty:)
-	mapM typeCheckStm ss
-	modify tail
+typeCheckStm (SBlock ss) = pushAndPop $ mapM typeCheckStm ss
 typeCheckStm (SIf e s s') = do
 	TBool <- typeCheckExp e
-	modify (empty:)
-	typeCheckStm s
-	modify (\s -> empty:tail s)
-	typeCheckStm s'
-	modify tail
+	pushAndPop $ typeCheckStm s
+	pushAndPop $ typeCheckStm s'
 typeCheckStm (SWhile e s) = do
 	TBool <- typeCheckExp e
-	modify (empty:)
-	typeCheckStm s
-	modify tail
+	pushAndPop $ typeCheckStm s
+typeCheckStm (SDeclD t i) = addVariable i t
 typeCheckStm (SDecl t i e) = do
 	t2 <- typeCheckExp e
 	assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+	addVariable i t
+typeCheckStm (SPrint e) = do
+	typeCheckExp e
+	return ()
+
+addVariable :: (MonadState Types m) => Ident -> Type -> m ()
+addVariable i t = do
 	(m:ms) <- get
 	case insertLookupWithKey (\k a1 a2 -> a1) i t m of
 		(Nothing,m') -> put (m':ms)
 		_ -> fail $ "Duplicate variable declaration: "++show i
-typeCheckStm (SPrint e) = do
-	typeCheckExp e
-	return ()